1 TADPOLE and BSWiMS

1.0.1 Loading the libraries

library("FRESA.CAD")
library(readxl)
library(igraph)
op <- par(no.readonly = TRUE)
pander::panderOptions('digits', 3)
pander::panderOptions('table.split.table', 400)
pander::panderOptions('keep.trailing.zeros',TRUE)

1.1 The data set

TADPOLE_D1_D2 <- read.csv("~/GitHub/BSWiMS/Data/TADPOLE/TADPOLE_D1_D2.csv")
TADPOLE_D1_D2_Dict <- read.csv("~/GitHub/BSWiMS/Data/TADPOLE/TADPOLE_D1_D2_Dict.csv")
TADPOLE_D1_D2_Dict_LR <- as.data.frame(read_excel("~/GitHub/BSWiMS/Data/TADPOLE/TADPOLE_D1_D2_Dict_LR.xlsx",sheet = "LeftRightFeatures"))


rownames(TADPOLE_D1_D2_Dict) <- TADPOLE_D1_D2_Dict$FLDNAME

1.2 Conditioning the data


# mm3 to mm
isVolume <- c("Ventricles","Hippocampus","WholeBrain","Entorhinal","Fusiform","MidTemp","ICV",
              TADPOLE_D1_D2_Dict$FLDNAME[str_detect(TADPOLE_D1_D2_Dict$TEXT,"Volume")]
              )


#TADPOLE_D1_D2[,isVolume] <- apply(TADPOLE_D1_D2[,isVolume],2,'^',(1/3))
TADPOLE_D1_D2[,isVolume] <- TADPOLE_D1_D2[,isVolume]^(1/3)

# mm2 to mm
isArea <- TADPOLE_D1_D2_Dict$FLDNAME[str_detect(TADPOLE_D1_D2_Dict$TEXT,"Area")]
TADPOLE_D1_D2[,isArea] <- sqrt(TADPOLE_D1_D2[,isArea])

# Get only cross sectional measurements
FreeSurfersetCross <- str_detect(colnames(TADPOLE_D1_D2),"UCSFFSX")

# The subset of baseline measurements
baselineTadpole <- subset(TADPOLE_D1_D2,VISCODE=="bl")
table(baselineTadpole$DX)
                   Dementia Dementia to MCI             MCI MCI to Dementia 
          7             336               1             864               5 
  MCI to NL              NL       NL to MCI 
          2             521               1 

rownames(baselineTadpole) <- baselineTadpole$PTID


validBaselineTadpole <- cbind(DX=baselineTadpole$DX,
                                 AGE=baselineTadpole$AGE,
                                 Gender=1*(baselineTadpole$PTGENDER=="Female"),
                                 ADAS11=baselineTadpole$ADAS11,
                                 ADAS13=baselineTadpole$ADAS13,
                                 MMSE=baselineTadpole$MMSE,
                                 RAVLT_immediate=baselineTadpole$RAVLT_immediate,
                                 RAVLT_learning=baselineTadpole$RAVLT_learning,
                                 RAVLT_forgetting=baselineTadpole$RAVLT_forgetting,
                                 RAVLT_perc_forgetting=baselineTadpole$RAVLT_perc_forgetting,
                                 FAQ=baselineTadpole$FAQ,
                                 Ventricles=baselineTadpole$Ventricles,
                                 Hippocampus=baselineTadpole$Hippocampus,
                                 WholeBrain=baselineTadpole$WholeBrain,
                                 Entorhinal=baselineTadpole$Entorhinal,
                                 Fusiform=baselineTadpole$Fusiform,
                                 MidTemp=baselineTadpole$MidTemp,
                                 ICV=baselineTadpole$ICV,
                                 baselineTadpole[,FreeSurfersetCross])


LeftFields <- TADPOLE_D1_D2_Dict_LR$LFN
names(LeftFields) <- LeftFields
LeftFields <- LeftFields[LeftFields %in% colnames(validBaselineTadpole)]
RightFields <- TADPOLE_D1_D2_Dict_LR$RFN
names(RightFields) <- RightFields
RightFields <- RightFields[RightFields %in% colnames(validBaselineTadpole)]

## Normalize to ICV
validBaselineTadpole$Ventricles=validBaselineTadpole$Ventricles/validBaselineTadpole$ICV
validBaselineTadpole$Hippocampus=validBaselineTadpole$Hippocampus/validBaselineTadpole$ICV
validBaselineTadpole$WholeBrain=validBaselineTadpole$WholeBrain/validBaselineTadpole$ICV
validBaselineTadpole$Entorhinal=validBaselineTadpole$Entorhinal/validBaselineTadpole$ICV
validBaselineTadpole$Fusiform=validBaselineTadpole$Fusiform/validBaselineTadpole$ICV
validBaselineTadpole$MidTemp=validBaselineTadpole$MidTemp/validBaselineTadpole$ICV

leftData <- validBaselineTadpole[,LeftFields]/validBaselineTadpole$ICV
RightData <- validBaselineTadpole[,RightFields]/validBaselineTadpole$ICV

## get mean and relative difference 
meanLeftRight <- (leftData + RightData)/2
difLeftRight <- abs(leftData - RightData)
reldifLeftRight <- difLeftRight/meanLeftRight
colnames(meanLeftRight) <- paste("M",colnames(meanLeftRight),sep="_")
colnames(difLeftRight) <- paste("D",colnames(difLeftRight),sep="_")
colnames(reldifLeftRight) <- paste("RD",colnames(reldifLeftRight),sep="_")


validBaselineTadpole <- validBaselineTadpole[,!(colnames(validBaselineTadpole) %in% 
                                               c(LeftFields,RightFields))]
validBaselineTadpole <- cbind(validBaselineTadpole,meanLeftRight,reldifLeftRight)

## Remove columns with too many NA more than %15 of NA
nacount <- apply(is.na(validBaselineTadpole),2,sum)/nrow(validBaselineTadpole) < 0.15
diagnose <- validBaselineTadpole$DX
pander::pander(table(diagnose))
  Dementia Dementia to MCI MCI MCI to Dementia MCI to NL NL NL to MCI
7 336 1 864 5 2 521 1
validBaselineTadpole <- validBaselineTadpole[,nacount]
## Remove character columns
ischar <- sapply(validBaselineTadpole,class) == "character"
validBaselineTadpole <- validBaselineTadpole[,!ischar]
## Place back diagnose
validBaselineTadpole$DX <- diagnose


validBaselineTadpole <- validBaselineTadpole[complete.cases(validBaselineTadpole),]
ischar <- sapply(validBaselineTadpole,class) == "character"
validBaselineTadpole[,!ischar] <- sapply(validBaselineTadpole[,!ischar],as.numeric)

colnames(validBaselineTadpole) <- str_remove_all(colnames(validBaselineTadpole),"_UCSFFSX_11_02_15_UCSFFSX51_08_01_16")
colnames(validBaselineTadpole) <- str_replace_all(colnames(validBaselineTadpole)," ","_")
validBaselineTadpole$LONISID <- NULL
validBaselineTadpole$IMAGEUID <- NULL
validBaselineTadpole$LONIUID <- NULL

diagnose <- as.character(validBaselineTadpole$DX)
validBaselineTadpole$DX <- diagnose
pander::pander(table(validBaselineTadpole$DX))
Dementia Dementia to MCI MCI MCI to Dementia MCI to NL NL NL to MCI
244 1 711 2 2 452 1


validDX <- c("NL","MCI","Dementia")

validBaselineTadpole <- validBaselineTadpole[validBaselineTadpole$DX %in% validDX,]
validBaselineTadpole$DX <- as.factor(validBaselineTadpole$DX)
pander::pander(table(validBaselineTadpole$DX))
Dementia MCI NL
244 711 452

1.3 Get the Time To Event on MCI Subjects


subjectsID <- rownames(validBaselineTadpole)
visitsID <- unique(TADPOLE_D1_D2$VISCODE)
baseDx <- TADPOLE_D1_D2[TADPOLE_D1_D2$VISCODE=="bl",c("PTID","DX","EXAMDATE")]
rownames(baseDx) <- baseDx$PTID 
baseDx <- baseDx[subjectsID,]
lastDx <- baseDx
toDementia <- baseDx
table(lastDx$DX)

Dementia MCI NL 244 711 452

hasDementia <- lastDx$PTID[str_detect(lastDx$DX,"Dementia")]


for (vid in visitsID)
{
  DxValue <- TADPOLE_D1_D2[TADPOLE_D1_D2$VISCODE==vid,c("PTID","DX","EXAMDATE")]
  rownames(DxValue) <- DxValue$PTID 
  DxValue <- DxValue[DxValue$PTID %in% subjectsID,]
  noDX <- DxValue$PTID[nchar(DxValue$DX) < 1]
  print(length(noDX))
  DxValue[noDX,] <- lastDx[noDX,]
  inLast <- lastDx$PTID[lastDx$PTID %in% DxValue$PTID]
  print(length(inLast))
  lastDx[inLast,] <- DxValue[inLast,]
  noDementia <- !(toDementia$PTID %in% hasDementia)
  toDementia[noDementia,] <- lastDx[noDementia,]
  hasDementia <- unique(c(hasDementia,lastDx$PTID[str_detect(lastDx$DX,"Dementia")]))
}

[1] 0 [1] 1407 [1] 2 [1] 1320 [1] 6 [1] 1212 [1] 23 [1] 1090 [1] 802 [1] 1054 [1] 29 [1] 706 [1] 20 [1] 212 [1] 14 [1] 167 [1] 32 [1] 551 [1] 25 [1] 297 [1] 18 [1] 130 [1] 665 [1] 665 [1] 112 [1] 112 [1] 176 [1] 176 [1] 177 [1] 177 [1] 624 [1] 624 [1] 251 [1] 251 [1] 159 [1] 159 [1] 7 [1] 7 [1] 17 [1] 99 [1] 9 [1] 63 [1] 1 [1] 1

table(lastDx$DX)
   Dementia Dementia to MCI             MCI MCI to Dementia       MCI to NL 
        426               2             460              80               7 
         NL  NL to Dementia       NL to MCI 
        405               1              26 
baseMCI <-baseDx$PTID[baseDx$DX == "MCI"]
lastDementia <- lastDx$PTID[str_detect(lastDx$DX,"Dementia")]
lastDementia2 <- toDementia$PTID[str_detect(toDementia$DX,"Dementia")]
lastNL <- lastDx$PTID[str_detect(lastDx$DX,"NL")]

MCIatBaseline <- baseDx[baseMCI,]
MCIatEvent <- toDementia[baseMCI,]
MCIatLast <- lastDx[baseMCI,]

MCIconverters <- MCIatBaseline[baseMCI %in% lastDementia,]
MCI_No_converters <- MCIatBaseline[!(baseMCI %in% MCIconverters$PTID),]
MCIconverters$TimeToEvent <- (as.Date(toDementia[MCIconverters$PTID,"EXAMDATE"]) 
                                   - as.Date(MCIconverters$EXAMDATE))

sum(MCIconverters$TimeToEvent ==0)

[1] 0



MCIconverters$AtEventDX <- MCIatEvent[MCIconverters$PTID,"DX"]
MCIconverters$LastDX <- MCIatLast[MCIconverters$PTID,"DX"]

MCI_No_converters$TimeToEvent <- (as.Date(lastDx[MCI_No_converters$PTID,"EXAMDATE"]) 
                                   - as.Date(MCI_No_converters$EXAMDATE))

MCI_No_converters$LastDX <- MCIatLast[MCI_No_converters$PTID,"DX"]

MCI_No_converters <- subset(MCI_No_converters,TimeToEvent > 0)

1.3.1 Correlation Matrix Data

The heat map of the testing set.


cormat <- cor(validBaselineTadpole[,colnames(validBaselineTadpole) != "DX"],method="spearman")
diag(cormat) <- 0;
corrmax <- apply(cormat,2,max)
whomax <- colnames(cormat)[corrmax>0.75]
gplots::heatmap.2(abs(cormat[whomax,whomax]),
                  trace = "none",
                  scale = "none",
                  mar = c(10,10),
                  col=rev(heat.colors(5)),
                  main = "Baseline TADPOLE Correlation",
                  cexRow = 0.5,
                  cexCol = 0.5,
                  key.title=NA,
                  key.xlab="Spearman Correlation",
                  xlab="Feature", ylab="Feature")

par(op)

2 Predicting ADAS13

Here we will diagnose ADAS13

2.1 Training and testing sets


TrainFraction <- 0.5;

TADPOLECrossMRI <- validBaselineTadpole
summary(TADPOLECrossMRI$ADAS13)

Min. 1st Qu. Median Mean 3rd Qu. Max. 0.00 9.00 14.67 16.37 22.00 51.00


TADPOLECrossMRI$ADAS11 <- NULL
TADPOLECrossMRI$MMSE <- NULL
TADPOLECrossMRI$RAVLT_immediate <- NULL
TADPOLECrossMRI$RAVLT_learning <- NULL
TADPOLECrossMRI$RAVLT_perc_forgetting <- NULL
TADPOLECrossMRI$RAVLT_forgetting <- NULL
TADPOLECrossMRI$FAQ <- NULL
TADPOLECrossMRI$DX <- NULL

trainSet <- sample(nrow(TADPOLECrossMRI),nrow(TADPOLECrossMRI)*TrainFraction)

TADPOLECrossMRITrain <- TADPOLECrossMRI[trainSet,]
TADPOLECrossMRITest <- TADPOLECrossMRI[-trainSet,]

2.1.1 Learning ADAS13

bml <- BSWiMS.model(ADAS13~.,TADPOLECrossMRITrain,maxTrainModelSize=50,NumberofRepeats = 20)

[++-+–+-++-++-+-+-+–++-++-+-++-+-+++-++-+-+-++-+-+-]…

pander::pander(bml$bagging$Jaccard.SM)

0.299

fs <- bml$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bml)
pander::pander(sm$coefficients)
  Estimate lower mean upper u.MSE r.MSE model.MSE NeRI F.pvalue t.pvalue Sign.pvalue Wilcox.pvalue Frequency
M_ST40TA -135.0232 -164.312 -135.0232 -105.7341 64.3 53.2 48.9 0.0820 0.00e+00 1.79e-06 0.01401 0.000785 0.15
M_ST24CV -75.3109 -99.777 -75.3109 -50.8450 60.8 47.0 44.6 0.0561 8.04e-10 1.23e-05 0.04898 0.001946 0.45
RD_ST32TA 21.8615 14.440 21.8615 29.2831 75.0 43.4 41.4 0.0064 3.88e-09 1.39e-02 0.48410 0.147555 1.00
Hippocampus -161.7606 -216.992 -161.7606 -106.5289 58.6 43.4 41.4 0.0745 4.73e-09 7.64e-04 0.02399 0.009590 1.00
M_ST24TA -338.3565 -456.667 -338.3565 -220.0458 56.7 43.3 41.4 0.0886 1.04e-08 1.07e-05 0.00874 0.001001 1.00
M_ST56TS 1873.9196 1182.131 1873.9196 2565.7081 81.3 43.1 41.4 0.0558 5.51e-08 7.43e-04 0.06147 0.015960 1.00
M_ST60SA 37.1529 22.451 37.1529 51.8548 83.0 45.5 44.0 0.0420 3.65e-07 9.07e-03 0.12496 0.066805 0.55
M_ST54TS 89.5081 53.603 89.5081 125.4126 81.6 53.1 51.2 0.0555 5.14e-07 1.07e-01 0.06244 0.168719 0.10
M_ST12SV -82.8267 -117.084 -82.8267 -48.5698 61.0 46.0 44.6 0.0684 1.07e-06 1.55e-03 0.02901 0.018707 0.45
M_ST39CV 57.2308 33.238 57.2308 81.2234 80.0 42.2 40.9 0.0430 1.47e-06 4.18e-03 0.11676 0.048345 0.40
M_ST52TA -360.3237 -511.408 -360.3237 -209.2389 71.4 43.5 42.2 0.0606 1.47e-06 3.19e-03 0.05055 0.020820 0.55
M_ST31CV -35.1903 -50.685 -35.1903 -19.6953 68.0 43.7 42.5 0.0441 4.27e-06 4.40e-03 0.09825 0.024367 0.40
M_ST62TA 233.7800 130.465 233.7800 337.0950 81.3 42.9 41.7 0.0353 4.60e-06 4.52e-02 0.15638 0.145967 0.55
M_ST47TS 522.6854 290.780 522.6854 754.5905 82.0 45.8 44.5 0.0629 4.99e-06 7.50e-04 0.04675 0.009359 0.40
RD_ST40CV 12.5238 6.621 12.5238 18.4264 77.1 44.2 43.1 0.0235 1.60e-05 5.58e-02 0.24577 0.126048 0.65
RD_ST31TA 19.3108 10.034 19.3108 28.5872 78.1 42.4 41.4 0.0583 2.25e-05 7.87e-03 0.05931 0.063638 1.00
M_ST57TA -79.8265 -118.438 -79.8265 -41.2148 73.9 42.5 41.5 0.0327 2.54e-05 3.99e-02 0.20215 0.179564 0.15
M_ST32CV -14.5650 -21.739 -14.5650 -7.3907 65.5 45.7 44.7 0.0223 3.46e-05 5.56e-02 0.28634 0.167421 0.15
M_ST55CV -55.4271 -82.734 -55.4271 -28.1204 72.9 43.9 42.9 0.0509 3.47e-05 9.44e-03 0.08908 0.067193 0.50
M_ST30SV 48.4884 23.728 48.4884 73.2491 62.1 42.8 41.9 0.0504 6.20e-05 1.74e-03 0.08333 0.017938 0.90
RD_ST40TA 3.4142 1.621 3.4142 5.2078 74.3 45.4 44.5 0.0316 9.54e-05 6.37e-02 0.20165 0.169337 0.25
M_ST40CV -61.6334 -94.073 -61.6334 -29.1935 63.7 42.9 42.0 0.0314 9.81e-05 7.31e-02 0.21204 0.121611 0.65
M_ST60CV 19.0522 8.790 19.0522 29.3144 76.6 41.8 41.0 0.0327 1.37e-04 3.42e-02 0.20305 0.108577 0.15
M_ST13SA -4.1309 -6.358 -4.1309 -1.9039 79.5 42.3 41.5 0.0441 1.39e-04 2.55e-01 0.12625 0.171488 0.10
M_ST65SV 36.5800 16.835 36.5800 56.3250 81.3 42.7 41.9 0.0377 1.41e-04 3.61e-02 0.13739 0.088187 0.20
M_ST17SV 18.1184 8.030 18.1184 28.2070 83.8 43.8 43.0 0.0597 2.16e-04 2.93e-03 0.05780 0.023159 0.30
AGE -0.0289 -0.045 -0.0289 -0.0127 81.9 42.5 41.8 0.0356 2.29e-04 3.02e-03 0.16288 0.037139 0.30
RD_ST47TS -1.8704 -2.938 -1.8704 -0.8028 82.9 45.5 44.8 0.0427 2.98e-04 3.75e-03 0.12913 0.073220 0.20
RD_ST52TA 1.7988 0.727 1.7988 2.8706 79.8 45.7 45.0 0.0299 5.02e-04 6.11e-03 0.22485 0.031818 0.10
RD_ST56TA 7.4024 2.507 7.4024 12.2982 81.9 45.0 44.5 0.0445 1.52e-03 7.59e-02 0.11513 0.193209 0.35
Ventricles -5.8305 -9.906 -5.8305 -1.7549 74.5 43.3 42.8 0.0200 2.52e-03 2.12e-02 0.28810 0.089125 0.65
M_ST24TS 59.2762 17.626 59.2762 100.9265 79.4 51.3 50.7 0.0541 2.64e-03 5.27e-03 0.06847 0.022925 0.10
pander::pander(bml$univariate[bml$selectedfeatures,])
  Name RName ZUni
M_ST24TA M_ST24TA M_ST24TA Inf
RD_ST32TA RD_ST32TA RD_ST32TA Inf
Hippocampus Hippocampus Hippocampus Inf
RD_ST31TA RD_ST31TA RD_ST31TA 7.19
M_ST56TS M_ST56TS M_ST56TS 4.85
M_ST30SV M_ST30SV M_ST30SV Inf
Ventricles Ventricles Ventricles Inf
M_ST13SA M_ST13SA M_ST13SA 6.27
M_ST40CV M_ST40CV M_ST40CV Inf
ST68SV ST68SV ST68SV 4.78
AGE AGE AGE 4.30
M_ST57TA M_ST57TA M_ST57TA Inf
M_ST39CV M_ST39CV M_ST39CV 5.90
M_ST62TA M_ST62TA M_ST62TA 4.83
M_ST60CV M_ST60CV M_ST60CV 8.13
M_ST55SA M_ST55SA M_ST55SA 5.22
M_ST24CV M_ST24CV M_ST24CV Inf
M_ST31CV M_ST31CV M_ST31CV Inf
M_ST52TA M_ST52TA M_ST52TA Inf
RD_ST40CV RD_ST40CV RD_ST40CV 7.82
M_ST55CV M_ST55CV M_ST55CV Inf
M_ST65SV M_ST65SV M_ST65SV 4.91
RD_ST47TS RD_ST47TS RD_ST47TS 3.14
M_ST12SV M_ST12SV M_ST12SV Inf
M_ST32CV M_ST32CV M_ST32CV Inf
M_ST17SV M_ST17SV M_ST17SV 1.60
RD_ST40TA RD_ST40TA RD_ST40TA Inf
RD_ST56TA RD_ST56TA RD_ST56TA 4.31
M_ST60SA M_ST60SA M_ST60SA 3.03
RD_ST52TA RD_ST52TA RD_ST52TA 6.05
M_ST47TS M_ST47TS M_ST47TS 4.16
M_ST40TA M_ST40TA M_ST40TA Inf
M_ST13TS M_ST13TS M_ST13TS 6.31
M_ST60TA M_ST60TA M_ST60TA Inf
M_ST24TS M_ST24TS M_ST24TS 6.37
RD_ST29SV RD_ST29SV RD_ST29SV 7.10
M_ST54TS M_ST54TS M_ST54TS 4.63
RD_ST52CV RD_ST52CV RD_ST52CV 4.62
RD_ST24TA RD_ST24TA RD_ST24TA 8.21
M_ST32SA M_ST32SA M_ST32SA 7.68
M_ST36TS M_ST36TS M_ST36TS 1.09
M_ST47TA M_ST47TA M_ST47TA 6.14

prreg <- predictionStats_regression(cbind(TADPOLECrossMRITest$ADAS13,predict(bml,TADPOLECrossMRITest)),"ADAS13")

ADAS13

pander::pander(prreg)
  • corci:

    cor    
    0.707 0.668 0.742
  • biasci: -0.261, -0.774 and 0.252

  • RMSEci: 6.94, 6.59 and 7.32

  • spearmanci:

    50% 2.5% 97.5%
    0.672 0.626 0.713
  • MAEci:

    50% 2.5% 97.5%
    5.4 5.09 5.72
  • pearson:

    Pearson’s product-moment correlation: predictions[, 1] and predictions[, 2]
    Test statistic df P value Alternative hypothesis cor
    26.5 702 1.37e-107 * * * two.sided 0.707
par(op)

2.1.2 The formula network

cmax <- apply(bml$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.250])
cmax <- cmax[cnames]

adma <- bml$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=5*E(gr)$weight,
     vertex.size=20*cmax,
     vertex.label.cex=0.5,
     vertex.label.dist=0,
     main="ADAS13 Feature Association")

par(op)

2.1.3 The ADAS13 table


clusterFeatures <- fc$names
sm$coefficients$Rx2 <- (sm$coefficients$r.MSE-sm$coefficients$model.MSE)/sm$coefficients$r.MSE

tableADAS13 <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "mean",
                                     "upper",
                                     "model.MSE",
                                     "Rx2",
                                     "F.pvalue",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableADAS13$Cluster <- nugget[rownames(tableADAS13)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableADAS13$Description <- description[rownames(tableADAS13)]
pander::pander(tableADAS13)
  Estimate lower mean upper model.MSE Rx2 F.pvalue Frequency Cluster Description
M_ST24TA -338.3565 -456.667 -338.3565 -220.0458 41.4 0.0438 1.04e-08 1.00 1 Cortical Thickness Average of LeftEntorhinal
RD_ST32TA 21.8615 14.440 21.8615 29.2831 41.4 0.0464 3.88e-09 1.00 1 Cortical Thickness Average of LeftInferiorTemporal
Hippocampus -161.7606 -216.992 -161.7606 -106.5289 41.4 0.0459 4.73e-09 1.00 1 NA
RD_ST31TA 19.3108 10.034 19.3108 28.5872 41.4 0.0235 2.25e-05 1.00 1 Cortical Thickness Average of LeftInferiorParietal
M_ST56TS 1873.9196 1182.131 1873.9196 2565.7081 41.4 0.0395 5.51e-08 1.00 1 Cortical Thickness Standard Deviation of LeftSuperiorFrontal
M_ST30SV 48.4884 23.728 48.4884 73.2491 41.9 0.0213 6.20e-05 0.90 1 Volume (WM Parcellation) of LeftInferiorLateralVentricle
Ventricles -5.8305 -9.906 -5.8305 -1.7549 42.8 0.0111 2.52e-03 0.65 2 NA
M_ST40CV -61.6334 -94.073 -61.6334 -29.1935 42.0 0.0197 9.81e-05 0.65 1 Volume (Cortical Parcellation) of LeftMiddleTemporal
AGE -0.0289 -0.045 -0.0289 -0.0127 41.8 0.0174 2.29e-04 0.30 1 NA
M_ST39CV 57.2308 33.238 57.2308 81.2234 40.9 0.0307 1.47e-06 0.40 1 Volume (Cortical Parcellation) of LeftMedialOrbitofrontal
M_ST62TA 233.7800 130.465 233.7800 337.0950 41.7 0.0275 4.60e-06 0.55 1 Cortical Thickness Average of LeftTransverseTemporal
M_ST24CV -75.3109 -99.777 -75.3109 -50.8450 44.6 0.0507 8.04e-10 0.45 2 Volume (Cortical Parcellation) of LeftEntorhinal
M_ST31CV -35.1903 -50.685 -35.1903 -19.6953 42.5 0.0281 4.27e-06 0.40 2 Volume (Cortical Parcellation) of LeftInferiorParietal
M_ST52TA -360.3237 -511.408 -360.3237 -209.2389 42.2 0.0307 1.47e-06 0.55 1 Cortical Thickness Average of LeftPrecuneus
RD_ST40CV 12.5238 6.621 12.5238 18.4264 43.1 0.0247 1.60e-05 0.65 2 Volume (Cortical Parcellation) of LeftMiddleTemporal
M_ST55CV -55.4271 -82.734 -55.4271 -28.1204 42.9 0.0226 3.47e-05 0.50 1 Volume (Cortical Parcellation) of LeftRostralMiddleFrontal
M_ST12SV -82.8267 -117.084 -82.8267 -48.5698 44.6 0.0315 1.07e-06 0.45 2 Volume (WM Parcellation) of LeftAmygdala
M_ST17SV 18.1184 8.030 18.1184 28.2070 43.0 0.0175 2.16e-04 0.30 2 Volume (WM Parcellation) of LeftCerebellumCortex
RD_ST40TA 3.4142 1.621 3.4142 5.2078 44.5 0.0199 9.54e-05 0.25 2 Cortical Thickness Average of LeftMiddleTemporal
RD_ST56TA 7.4024 2.507 7.4024 12.2982 44.5 0.0124 1.52e-03 0.35 2 Cortical Thickness Average of LeftSuperiorFrontal
M_ST60SA 37.1529 22.451 37.1529 51.8548 44.0 0.0346 3.65e-07 0.55 2 Surface Area of LeftTemporalPole
M_ST47TS 522.6854 290.780 522.6854 754.5905 44.5 0.0276 4.99e-06 0.40 2 Cortical Thickness Standard Deviation of LeftParsTriangularis

2.1.4 Decorrelating training and testing sets



TADPOLECrossMRITrainD <- GDSTMDecorrelation(TADPOLECrossMRITrain,Outcome="ADAS13",
                                        thr=0.6,
                                        type="RLM",
                                        method="spearman",
                                        verbose = TRUE)
#> 
#>  Included: 204 , Uni p: 0.01148552 To Outcome: 132 , Base: 7 , In Included: 7 , Base Cor: 18 
#> 1 , Top: 40 < 0.6 >( 2 )[ 1 : 0 : 0.594 ]( 39 , 95 , 0 ),<>Tot Used: 134 , Added: 95 , Zero Std: 0 , Max Cor: 0.9558371 
#> 2 , Top: 27 < 0.6 >( 1 )[ 1 : 0 : 0.594 ]( 27 , 38 , 39 ),<>Tot Used: 159 , Added: 38 , Zero Std: 0 , Max Cor: 0.9365909 
#> 3 , Top: 18 < 0.6 >( 4 )[ 1 : 0 : 0 ]( 15 , 20 , 63 ),<>Tot Used: 160 , Added: 20 , Zero Std: 0 , Max Cor: 0.9408258 
#> 4 , Top: 10 < 0.6 >( 1 )[ 1 : 0 : 0 ]( 10 , 11 , 74 ),<>Tot Used: 161 , Added: 11 , Zero Std: 0 , Max Cor: 0.6387514 
#> 5 , Top: 2 < 0.6 >( 1 )[ 1 : 0 : 0.6 ]( 2 , 2 , 81 ),<>Tot Used: 161 , Added: 2 , Zero Std: 0 , Max Cor: 0.7764574 
#> 6 , Top: 1 < 0.6 >( 1 )[ 1 : 0 : 0.6 ]( 1 , 1 , 81 ),<>Tot Used: 161 , Added: 1 , Zero Std: 0 , Max Cor: 0.5988357 
#> [ 7 ], 0.593303 . Cor to Base: 101 , ABase: 69
TADPOLECrossMRITestD <-  predictDecorrelate(TADPOLECrossMRITrainD,TADPOLECrossMRITest)

2.2 Decorrelated

bmlD <- BSWiMS.model(ADAS13~.,TADPOLECrossMRITrainD,maxTrainModelSize=50,NumberofRepeats = 20)

[++-++-++-++-++-++-++-++-++-++-++-++-++-++-++-++-++-++-++-++-]….

pander::pander(bmlD$bagging$Jaccard.SM)

0.281

fs <- bmlD$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bmlD)
pander::pander(sm$coefficients)
  Estimate lower mean upper u.MSE r.MSE model.MSE NeRI F.pvalue t.pvalue Sign.pvalue Wilcox.pvalue Frequency
Ba_Hippocampus -166.695 -190.219 -166.695 -143.171 58.6 58.7 42.4 0.22959 0.00e+00 8.02e-26 5.28e-10 1.16e-13 1.00
Ba_M_ST59TA -1431.291 -1633.277 -1431.291 -1229.305 73.2 54.6 43.2 0.21081 0.00e+00 2.88e-20 1.03e-08 1.45e-11 1.00
De_M_ST58TA 1737.239 1462.807 1737.239 2011.671 81.0 49.3 43.2 0.13784 0.00e+00 1.39e-10 8.52e-05 2.79e-06 1.00
De_M_ST58CV -406.753 -505.911 -406.753 -307.596 83.7 46.2 43.2 0.12046 0.00e+00 2.46e-06 4.97e-04 1.23e-04 0.95
De_M_ST24TA -209.054 -274.005 -209.054 -144.103 78.8 44.9 42.4 0.09587 1.41e-10 6.21e-06 5.57e-03 1.17e-03 1.00
RD_ST32TA 13.129 8.928 13.129 17.331 75.0 44.8 42.4 0.00697 4.54e-10 1.52e-02 4.76e-01 1.76e-01 1.00
De_M_ST24CV -137.823 -189.385 -137.823 -86.261 80.3 45.0 43.2 0.05877 8.08e-08 3.76e-05 5.73e-02 3.84e-03 0.95
Ba_M_ST40TS 838.846 504.556 838.846 1173.136 83.4 44.8 43.3 0.06143 4.37e-07 3.58e-03 4.68e-02 3.46e-02 0.55
RD_ST31TA 12.986 7.763 12.986 18.210 78.1 43.9 42.4 0.04950 5.50e-07 4.43e-03 8.66e-02 4.73e-02 1.00
De_M_ST31TA -651.605 -924.380 -651.605 -378.830 80.2 44.0 42.6 0.02276 1.42e-06 5.42e-02 2.61e-01 2.37e-01 1.00
De_M_ST60SA 60.052 33.625 60.052 86.479 83.0 44.4 43.1 0.01759 4.22e-06 2.18e-02 2.90e-01 1.30e-01 0.95
De_WholeBrain 11.449 6.349 11.449 16.548 83.8 44.2 43.0 0.07425 5.41e-06 1.97e-04 2.11e-02 4.71e-03 0.25
De_M_ST52TA -634.123 -927.284 -634.123 -340.961 82.3 44.1 43.0 0.03528 1.12e-05 1.55e-02 1.74e-01 6.11e-02 1.00
M_ST47TS 841.935 452.255 841.935 1231.614 82.0 43.7 42.6 0.05737 1.14e-05 2.80e-03 6.52e-02 2.74e-02 0.90
De_M_ST40SA -9.693 -14.358 -9.693 -5.028 77.5 43.8 42.7 0.08393 2.32e-05 7.80e-03 1.27e-02 1.57e-02 0.35
Ba_RD_ST40CV 14.111 7.311 14.111 20.911 77.1 44.1 43.1 0.03983 2.38e-05 2.47e-02 1.28e-01 7.34e-02 0.80
De_M_ST40CV -100.743 -150.158 -100.743 -51.328 80.2 44.0 43.0 0.02646 3.22e-05 5.47e-02 2.55e-01 1.62e-01 0.50
Ba_M_ST129TS 244.673 119.712 244.673 369.633 81.4 43.8 42.9 0.00933 6.21e-05 7.06e-02 4.61e-01 1.83e-01 0.45
M_ST13TS 482.762 231.983 482.762 733.540 79.4 44.2 43.3 0.03335 8.06e-05 9.49e-03 1.79e-01 7.46e-02 0.45
Ba_M_ST32SA -12.209 -18.693 -12.209 -5.725 77.3 43.9 43.1 0.04780 1.12e-04 5.80e-03 9.47e-02 4.25e-02 0.50
RD_ST40TA 7.117 3.311 7.117 10.923 74.3 44.4 43.6 0.02987 1.24e-04 1.66e-01 2.19e-01 2.51e-01 0.45
De_Ventricles 113.936 51.830 113.936 176.041 77.1 43.3 42.5 0.08919 1.62e-04 1.43e-03 8.47e-03 1.60e-03 1.00
De_M_ST40TA -96.745 -149.680 -96.745 -43.810 82.7 43.9 43.1 0.04505 1.70e-04 4.71e-02 1.12e-01 6.66e-02 0.15
De_M_ST31SA -1.145 -1.781 -1.145 -0.510 79.3 43.2 42.4 0.04125 2.07e-04 1.92e-01 1.45e-01 1.72e-01 0.10
De_M_ST32CV -92.254 -143.546 -92.254 -40.962 81.1 43.9 43.2 0.01630 2.12e-04 1.23e-01 3.20e-01 2.83e-01 0.65
De_M_ST13CV 291.110 126.967 291.110 455.253 82.0 43.5 42.7 0.02646 2.54e-04 8.70e-02 2.07e-01 2.08e-01 0.75
M_ST17SV 33.533 14.551 33.533 52.516 83.8 43.7 42.9 0.05625 2.68e-04 1.71e-03 6.52e-02 1.69e-02 0.55
De_M_ST55SA -10.147 -15.909 -10.147 -4.385 80.9 43.5 42.7 0.06543 2.79e-04 6.03e-02 3.78e-02 1.22e-01 0.70
Ba_M_ST56SA -3.335 -5.256 -3.335 -1.414 82.1 43.6 42.9 -0.01778 3.34e-04 1.31e-01 1.00e+00 3.12e-01 0.20
De_M_ST62TA 153.680 63.933 153.680 243.427 83.2 43.1 42.4 0.01262 3.95e-04 1.30e-01 4.08e-01 2.51e-01 0.80
Ba_M_ST65SV 13.099 5.238 13.099 20.961 81.3 43.3 42.6 0.07160 5.46e-04 1.10e-02 2.95e-02 2.54e-02 0.15
Ba_M_ST54TS 141.529 55.372 141.529 227.686 81.6 43.5 42.9 0.01402 6.42e-04 8.27e-02 3.71e-01 2.10e-01 0.35
Ba_M_ST13SA -21.484 -34.573 -21.484 -8.394 79.5 43.7 43.0 0.03044 6.48e-04 1.15e-01 2.03e-01 1.80e-01 0.75
M_ST24TS 189.693 59.356 189.693 320.030 79.4 43.6 43.1 0.02952 2.17e-03 1.08e-01 2.24e-01 1.95e-01 0.40
RD_ST60TA 0.581 0.180 0.581 0.982 78.2 43.5 43.0 -0.02703 2.28e-03 6.65e-01 1.00e+00 8.66e-01 0.10
Ba_M_ST35SA -1.890 -3.297 -1.890 -0.483 82.9 43.1 42.6 0.07065 4.24e-03 3.06e-04 3.27e-02 5.85e-03 0.15
RD_ST24TA 3.280 0.824 3.280 5.736 76.3 43.6 43.2 0.03253 4.43e-03 2.53e-01 1.79e-01 2.57e-01 0.75
De_M_ST52CV 44.974 10.243 44.974 79.705 82.7 43.5 43.1 0.00711 5.57e-03 9.54e-02 5.08e-01 2.85e-01 0.15
RD_ST29SV 1.339 0.237 1.339 2.441 78.3 43.5 43.1 0.08393 8.63e-03 3.62e-02 1.43e-02 1.23e-02 0.10
pander::pander(bmlD$univariate[bmlD$selectedfeatures,])
  Name RName ZUni
Ba_Hippocampus Ba_Hippocampus Ba_Hippocampus Inf
De_M_ST24TA De_M_ST24TA De_M_ST24TA 6.78
RD_ST32TA RD_ST32TA RD_ST32TA Inf
RD_ST56TA RD_ST56TA RD_ST56TA 4.31
RD_ST31TA RD_ST31TA RD_ST31TA 7.19
De_RD_ST15CV De_RD_ST15CV De_RD_ST15CV 3.34
De_M_ST62TA De_M_ST62TA De_M_ST62TA 2.79
Ba_M_ST65SV Ba_M_ST65SV Ba_M_ST65SV 4.91
De_Ventricles De_Ventricles De_Ventricles 7.78
De_M_ST31TA De_M_ST31TA De_M_ST31TA 5.78
De_M_ST31SA De_M_ST31SA De_M_ST31SA 6.44
M_ST47TS M_ST47TS M_ST47TS 4.16
Ba_M_ST59TA Ba_M_ST59TA Ba_M_ST59TA Inf
Ba_M_ST13SA Ba_M_ST13SA Ba_M_ST13SA 6.27
De_M_ST13CV De_M_ST13CV De_M_ST13CV 4.22
De_M_ST55SA De_M_ST55SA De_M_ST55SA 5.22
Ba_M_ST129TS Ba_M_ST129TS Ba_M_ST129TS 4.73
De_M_ST58TA De_M_ST58TA De_M_ST58TA 5.14
De_M_ST24CV De_M_ST24CV De_M_ST24CV 5.72
De_M_ST52TA De_M_ST52TA De_M_ST52TA 3.88
De_M_ST32CV De_M_ST32CV De_M_ST32CV 5.03
RD_ST24TA RD_ST24TA RD_ST24TA 8.21
Ba_RD_ST40CV Ba_RD_ST40CV Ba_RD_ST40CV 7.82
RD_ST40TA RD_ST40TA RD_ST40TA Inf
RD_ST29SV RD_ST29SV RD_ST29SV 7.10
De_M_ST40CV De_M_ST40CV De_M_ST40CV 5.76
De_M_ST40SA De_M_ST40SA De_M_ST40SA 7.54
RD_ST60TA RD_ST60TA RD_ST60TA 7.13
M_ST13TS M_ST13TS M_ST13TS 6.31
Ba_M_ST32SA Ba_M_ST32SA Ba_M_ST32SA 7.68
Ba_M_ST40TS Ba_M_ST40TS Ba_M_ST40TS 2.36
M_ST24TS M_ST24TS M_ST24TS 6.37
Ba_M_ST54TS Ba_M_ST54TS Ba_M_ST54TS 4.63
De_M_ST60SA De_M_ST60SA De_M_ST60SA 3.03
De_M_ST58CV De_M_ST58CV De_M_ST58CV 1.69
Ba_M_ST37SV Ba_M_ST37SV Ba_M_ST37SV Inf
De_WholeBrain De_WholeBrain De_WholeBrain 1.53
De_M_ST52CV De_M_ST52CV De_M_ST52CV 3.40
M_ST17SV M_ST17SV M_ST17SV 1.60
M_ST60TS M_ST60TS M_ST60TS 4.22
Ba_M_ST56SA Ba_M_ST56SA Ba_M_ST56SA 4.13
Ba_M_ST35SA Ba_M_ST35SA Ba_M_ST35SA 3.09
De_M_ST40TA De_M_ST40TA De_M_ST40TA 3.43
De_M_ST31CV De_M_ST31CV De_M_ST31CV 3.47

prreg <- predictionStats_regression(cbind(TADPOLECrossMRITestD$ADAS13,predict(bmlD,TADPOLECrossMRITestD)),"ADAS13")

ADAS13

pander::pander(prreg)
  • corci:

    cor    
    0.704 0.665 0.74
  • biasci: -0.396, -0.910 and 0.118

  • RMSEci: 6.96, 6.62 and 7.35

  • spearmanci:

    50% 2.5% 97.5%
    0.673 0.625 0.714
  • MAEci:

    50% 2.5% 97.5%
    5.37 5.05 5.7
  • pearson:

    Pearson’s product-moment correlation: predictions[, 1] and predictions[, 2]
    Test statistic df P value Alternative hypothesis cor
    26.3 702 1.32e-106 * * * two.sided 0.704
par(op)

2.2.1 The formula network

cmax <- apply(bmlD$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.250])
cmax <- cmax[cnames]

adma <- bmlD$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=5*E(gr)$weight,
     vertex.size=20*cmax,
     vertex.label.cex=0.5,
     vertex.label.dist=0,
     main="ADAS13 Feature Association")

par(op)

2.2.2 Decorrelated ADAS13 table


clusterFeatures <- fc$names
sm$coefficients$Rx2 <- (sm$coefficients$r.MSE-sm$coefficients$model.MSE)/sm$coefficients$r.MSE

tableADAS13D <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "mean",
                                     "upper",
                                     "model.MSE",
                                     "Rx2",
                                     "F.pvalue",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableADAS13D$Cluster <- nugget[rownames(tableADAS13D)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableADAS13D$Description <- description[rownames(tableADAS13D)]

## Getting the decorrelation formula
dc <- getDerivedCoefficients(TADPOLECrossMRITrainD)
decornames <- rownames(sm$coefficients)

deNames_in_dc <- decornames[decornames %in% names(dc)]
theDeFormulas <- dc[deNames_in_dc]
deFromula <- character(length(theDeFormulas))
names(deFromula) <- names(theDeFormulas)
for (dx in names(deFromula))
{
  coef <- theDeFormulas[[dx]]
  cname <- names(theDeFormulas[[dx]])
  names(cname) <- cname
  for (cf in names(coef))
  {
    if (cf != dx)
    {
      if (coef[cf]>0)
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("+ %5.3f*%s",coef[cf],cname[cf]))
      }
      else
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("%5.3f*%s",coef[cf],cname[cf]))
      }
    }
  }
}

tableADAS13D$DecorFormula <- deFromula[rownames(tableADAS13D)]


pander::pander(tableADAS13D)
  Estimate lower mean upper model.MSE Rx2 F.pvalue Frequency Cluster Description DecorFormula
Ba_Hippocampus -166.70 -190.219 -166.70 -143.17 42.4 0.27748 0.00e+00 1.00 1 NA NA
De_M_ST24TA -209.05 -274.005 -209.05 -144.10 42.4 0.05509 1.41e-10 1.00 1 Cortical Thickness Average of LeftEntorhinal -0.314Hippocampus + 1.000M_ST24TA
RD_ST32TA 13.13 8.928 13.13 17.33 42.4 0.05201 4.54e-10 1.00 1 Cortical Thickness Average of LeftInferiorTemporal NA
RD_ST31TA 12.99 7.763 12.99 18.21 42.4 0.03324 5.50e-07 1.00 1 Cortical Thickness Average of LeftInferiorParietal NA
De_M_ST62TA 153.68 63.933 153.68 243.43 42.4 0.01594 3.95e-04 0.80 1 Cortical Thickness Average of LeftTransverseTemporal -0.922M_ST59TA + 1.000M_ST62TA
De_Ventricles 113.94 51.830 113.94 176.04 42.5 0.01832 1.62e-04 1.00 1 NA + 1.000Ventricles -1.284M_ST37SV
De_M_ST31TA -651.61 -924.380 -651.61 -378.83 42.6 0.03074 1.42e-06 1.00 1 Cortical Thickness Average of LeftInferiorParietal + 1.000M_ST31TA -0.934M_ST59TA
M_ST47TS 841.93 452.255 841.93 1231.61 42.6 0.02529 1.14e-05 0.90 1 Cortical Thickness Standard Deviation of LeftParsTriangularis NA
Ba_M_ST59TA -1431.29 -1633.277 -1431.29 -1229.30 43.2 0.20785 0.00e+00 1.00 2 Cortical Thickness Average of LeftSupramarginal NA
Ba_M_ST13SA -21.48 -34.573 -21.48 -8.39 43.0 0.01469 6.48e-04 0.75 2 Surface Area of LeftBankssts NA
De_M_ST13CV 291.11 126.967 291.11 455.25 42.7 0.01710 2.54e-04 0.75 1 Volume (Cortical Parcellation) of LeftBankssts -1.727M_ST13TA -0.213M_ST59TA -0.295M_ST13SA + 1.000M_ST13CV
De_M_ST55SA -10.15 -15.909 -10.15 -4.38 42.7 0.01690 2.79e-04 0.70 1 Surface Area of LeftRostralMiddleFrontal NA
Ba_M_ST129TS 244.67 119.712 244.67 369.63 42.9 0.02077 6.21e-05 0.45 1 Cortical Thickness Standard Deviation of LeftInsula NA
De_M_ST58TA 1737.24 1462.807 1737.24 2011.67 43.2 0.12280 0.00e+00 1.00 2 Cortical Thickness Average of LeftSuperiorTemporal -0.130Hippocampus + 1.000M_ST58TA -0.561*M_ST59TA
De_M_ST24CV -137.82 -189.385 -137.82 -86.26 43.2 0.03838 8.08e-08 0.95 2 Volume (Cortical Parcellation) of LeftEntorhinal -0.552Hippocampus + 1.000M_ST24CV
De_M_ST52TA -634.12 -927.284 -634.12 -340.96 43.0 0.02527 1.12e-05 1.00 2 Cortical Thickness Average of LeftPrecuneus + 1.000M_ST52TA -0.850M_ST59TA
De_M_ST32CV -92.25 -143.546 -92.25 -40.96 43.2 0.01808 2.12e-04 0.65 2 Volume (Cortical Parcellation) of LeftInferiorTemporal -2.388M_ST59TA -0.270M_ST32SA + 1.000*M_ST32CV
RD_ST24TA 3.28 0.824 3.28 5.74 43.2 0.00979 4.43e-03 0.75 2 Cortical Thickness Average of LeftEntorhinal NA
Ba_RD_ST40CV 14.11 7.311 14.11 20.91 43.1 0.02330 2.38e-05 0.80 2 Volume (Cortical Parcellation) of LeftMiddleTemporal NA
RD_ST40TA 7.12 3.311 7.12 10.92 43.6 0.01901 1.24e-04 0.45 2 Cortical Thickness Average of LeftMiddleTemporal NA
De_M_ST40CV -100.74 -150.158 -100.74 -51.33 43.0 0.02259 3.22e-05 0.50 2 Volume (Cortical Parcellation) of LeftMiddleTemporal -2.845M_ST59TA -0.273M_ST40SA + 1.000*M_ST40CV
De_M_ST40SA -9.69 -14.358 -9.69 -5.03 42.7 0.02345 2.32e-05 0.35 2 Surface Area of LeftMiddleTemporal NA
M_ST13TS 482.76 231.983 482.76 733.54 43.3 0.02011 8.06e-05 0.45 2 Cortical Thickness Standard Deviation of LeftBankssts NA
Ba_M_ST32SA -12.21 -18.693 -12.21 -5.72 43.1 0.01920 1.12e-04 0.50 2 Surface Area of LeftInferiorTemporal NA
Ba_M_ST40TS 838.85 504.556 838.85 1173.14 43.3 0.03400 4.37e-07 0.55 2 Cortical Thickness Standard Deviation of LeftMiddleTemporal NA
M_ST24TS 189.69 59.356 189.69 320.03 43.1 0.01154 2.17e-03 0.40 2 Cortical Thickness Standard Deviation of LeftEntorhinal NA
Ba_M_ST54TS 141.53 55.372 141.53 227.69 42.9 0.01477 6.42e-04 0.35 2 Cortical Thickness Standard Deviation of LeftRostralAnteriorCingulate NA
De_M_ST60SA 60.05 33.625 60.05 86.48 43.1 0.02798 4.22e-06 0.95 2 Surface Area of LeftTemporalPole NA
De_M_ST58CV -406.75 -505.911 -406.75 -307.60 43.2 0.06429 0.00e+00 0.95 2 Volume (Cortical Parcellation) of LeftSuperiorTemporal -3.359M_ST59TA -0.243M_ST58SA + 1.000*M_ST58CV
De_WholeBrain 11.45 6.349 11.45 16.55 43.0 0.02731 5.41e-06 0.25 2 NA -1.479Hippocampus + 1.000WholeBrain
M_ST17SV 33.53 14.551 33.53 52.52 42.9 0.01696 2.68e-04 0.55 2 Volume (WM Parcellation) of LeftCerebellumCortex NA

3 Diagnosis MCI vs AD

3.0.1 the set

TrainFraction <- 0.60;

TADPOLECrossMRI <- subset(validBaselineTadpole,DX == "Dementia" | DX == "MCI")
table(TADPOLECrossMRI$DX)

Dementia MCI NL 244 711 0


TADPOLECrossMRI$DX <- 1*(as.character(TADPOLECrossMRI$DX) == "Dementia")
table(TADPOLECrossMRI$DX)

0 1 711 244

TADPOLECrossMRI$ADAS13 <- NULL
TADPOLECrossMRI$ADAS11 <- NULL
TADPOLECrossMRI$MMSE <- NULL
TADPOLECrossMRI$RAVLT_immediate <- NULL
TADPOLECrossMRI$RAVLT_learning <- NULL
TADPOLECrossMRI$RAVLT_perc_forgetting <- NULL
TADPOLECrossMRI$RAVLT_forgetting <- NULL
TADPOLECrossMRI$FAQ <- NULL

TADPOLE_Cases <- subset(TADPOLECrossMRI,DX==1)
TADPOLE_Controls <- subset(TADPOLECrossMRI,DX==0)
trainCasesSet <- sample(nrow(TADPOLE_Cases),nrow(TADPOLE_Cases)*TrainFraction)
trainControlSet <- sample(nrow(TADPOLE_Controls),nrow(TADPOLE_Controls)*TrainFraction)

TADPOLE_DX_TRAIN <- rbind(TADPOLE_Cases[trainCasesSet,],TADPOLE_Controls[trainControlSet,])
TADPOLE_DX_TEST <- TADPOLECrossMRI[!(rownames(TADPOLECrossMRI) %in% rownames(TADPOLE_DX_TRAIN)),]
table(TADPOLE_DX_TEST$DX)

0 1 285 98


par(op)

3.0.2 Learning

bDXml <- BSWiMS.model(DX~.,TADPOLE_DX_TRAIN,NumberofRepeats = 20)

[++++-+-+++++-+++++-+++++++-+++++-+-++++–++++++-+++—-+++++–++++–+-++++++-++++++-+++-++-+++++-+++-++-++++++-++++++-++++-+-+++++–++-+–]……….

pander::pander(bDXml$bagging$Jaccard.SM)

0.0986


fs <- bDXml$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bDXml)
pander::pander(sm$coefficients)
  Estimate lower OR upper u.Accuracy r.Accuracy full.Accuracy u.AUC r.AUC full.AUC IDI NRI z.IDI z.NRI Frequency
M_ST24TA -48.263 1.01e-24 1.10e-21 1.19e-18 0.727 0.691 0.748 0.724 0.690 0.757 0.1146 0.676 10.63 10.55 1.00
M_ST24CV -27.345 1.26e-14 1.33e-12 1.41e-10 0.694 0.695 0.741 0.691 0.694 0.745 0.0888 0.553 9.01 8.54 1.00
Hippocampus -14.025 6.53e-08 8.11e-07 1.01e-05 0.683 0.684 0.719 0.687 0.683 0.726 0.0886 0.538 8.96 8.29 0.90
M_ST58TA -7.204 2.05e-04 7.43e-04 2.69e-03 0.646 0.667 0.711 0.646 0.667 0.716 0.0771 0.522 8.44 7.92 0.10
M_ST12SV -20.770 1.36e-11 9.54e-10 6.69e-08 0.684 0.694 0.723 0.692 0.694 0.731 0.0639 0.540 7.66 8.22 0.90
M_ST60TA -23.861 2.25e-13 4.34e-11 8.36e-09 0.659 0.683 0.716 0.661 0.685 0.718 0.0627 0.465 7.50 7.04 0.70
M_ST32TA -68.352 6.65e-37 2.07e-30 6.42e-24 0.663 0.702 0.721 0.668 0.705 0.728 0.0656 0.532 7.46 8.13 0.95
M_ST26TA -9.939 7.13e-06 4.83e-05 3.27e-04 0.647 0.707 0.728 0.650 0.707 0.727 0.0697 0.460 7.40 7.07 0.10
M_ST40TA -28.750 6.76e-16 3.27e-13 1.58e-10 0.671 0.687 0.725 0.673 0.687 0.727 0.0618 0.498 7.36 7.59 0.45
M_ST40CV -7.280 1.28e-04 6.90e-04 3.71e-03 0.668 0.693 0.716 0.668 0.686 0.719 0.0550 0.458 7.09 6.91 0.60
M_ST32CV -17.997 1.96e-10 1.53e-08 1.19e-06 0.684 0.727 0.751 0.682 0.726 0.757 0.0544 0.514 6.92 7.80 1.00
M_ST32SA -2.607 3.75e-02 7.37e-02 1.45e-01 0.627 0.693 0.724 0.619 0.691 0.725 0.0463 0.487 6.52 7.36 0.60
M_ST31CV -10.484 1.52e-06 2.80e-05 5.16e-04 0.648 0.716 0.731 0.648 0.716 0.740 0.0450 0.369 6.36 5.52 0.75
M_ST30SV 4.199 1.71e+01 6.66e+01 2.59e+02 0.674 0.718 0.733 0.671 0.718 0.738 0.0352 0.308 5.63 4.58 1.00
M_ST60TS 48.891 5.52e+13 1.71e+21 5.31e+28 0.615 0.700 0.717 0.610 0.709 0.724 0.0312 0.416 5.47 6.23 0.60
M_ST60SA 1.250 2.23e+00 3.49e+00 5.46e+00 0.519 0.733 0.760 0.516 0.735 0.770 0.0308 0.339 5.37 5.05 0.10
M_ST13TS 107.209 4.04e+29 3.63e+46 3.27e+63 0.594 0.714 0.719 0.578 0.715 0.723 0.0351 0.333 5.31 4.96 0.65
M_ST40TS 18.046 7.27e+04 6.88e+07 6.50e+10 0.577 0.707 0.721 0.550 0.705 0.722 0.0314 0.355 5.10 5.30 0.20
M_ST46TS 151.043 2.49e+41 3.95e+65 6.29e+89 0.569 0.736 0.748 0.550 0.744 0.756 0.0306 0.330 5.07 4.92 1.00
RD_ST52TA 1.761 2.96e+00 5.82e+00 1.14e+01 0.608 0.722 0.732 0.553 0.727 0.735 0.0294 0.211 5.05 3.18 0.85
RD_ST32TA 0.965 1.81e+00 2.62e+00 3.79e+00 0.645 0.707 0.728 0.610 0.715 0.732 0.0295 0.425 5.00 6.42 0.70
RD_ST35TA 1.302 2.23e+00 3.68e+00 6.06e+00 0.625 0.701 0.720 0.600 0.706 0.723 0.0278 0.383 4.99 5.75 0.75
M_ST129TS 40.276 3.94e+10 3.10e+17 2.45e+24 0.585 0.721 0.728 0.564 0.723 0.728 0.0290 0.287 4.87 4.27 0.40
M_ST24SA 6.624 6.07e+01 7.53e+02 9.35e+03 0.538 0.726 0.740 0.549 0.735 0.743 0.0270 0.202 4.85 2.98 0.75
M_ST35SA -0.478 5.10e-01 6.20e-01 7.54e-01 0.554 0.701 0.723 0.563 0.703 0.730 0.0238 0.314 4.76 4.65 0.20
M_ST39CV 5.651 2.87e+01 2.85e+02 2.82e+03 0.565 0.718 0.730 0.555 0.723 0.735 0.0250 0.226 4.73 3.33 0.45
M_ST43TS 151.462 2.65e+38 6.01e+65 1.37e+93 0.548 0.727 0.734 0.530 0.732 0.739 0.0259 0.274 4.55 4.06 1.00
M_ST47CV 3.612 7.90e+00 3.70e+01 1.74e+02 0.551 0.712 0.726 0.545 0.720 0.733 0.0220 0.258 4.49 3.81 0.30
M_ST21SV 2.141 3.38e+00 8.51e+00 2.14e+01 0.615 0.718 0.721 0.614 0.720 0.727 0.0241 0.249 4.47 3.67 0.20
M_ST26CV -1.809 7.47e-02 1.64e-01 3.59e-01 0.659 0.711 0.721 0.655 0.711 0.723 0.0232 0.332 4.34 4.94 0.25
RD_ST55TA 0.358 1.22e+00 1.43e+00 1.67e+00 0.623 0.712 0.724 0.590 0.717 0.724 0.0220 0.318 4.30 4.75 0.15
RD_ST66SV -0.424 5.33e-01 6.55e-01 8.04e-01 0.524 0.724 0.731 0.578 0.728 0.735 0.0184 0.332 3.92 5.06 0.55
M_ST43TA 8.373 6.47e+01 4.33e+03 2.90e+05 0.562 0.724 0.728 0.545 0.728 0.731 0.0163 0.274 3.78 4.06 0.15
pander::pander(bDXml$univariate[bDXml$selectedfeatures,])
  Name RName ZUni
M_ST24TA M_ST24TA M_ST24TA 10.60
M_ST32CV M_ST32CV M_ST32CV 8.92
M_ST24CV M_ST24CV M_ST24CV 9.26
M_ST46TS M_ST46TS M_ST46TS 2.35
M_ST31CV M_ST31CV M_ST31CV 7.46
M_ST30SV M_ST30SV M_ST30SV 8.76
M_ST60SA M_ST60SA M_ST60SA 1.69
M_ST24SA M_ST24SA M_ST24SA 1.92
Hippocampus Hippocampus Hippocampus 9.46
RD_ST52TA RD_ST52TA RD_ST52TA 4.44
M_ST43TS M_ST43TS M_ST43TS 2.56
M_ST12SV M_ST12SV M_ST12SV 8.92
RD_ST32TA RD_ST32TA RD_ST32TA 4.42
M_ST51TA M_ST51TA M_ST51TA 3.67
M_ST129TS M_ST129TS M_ST129TS 3.38
M_ST47CV M_ST47CV M_ST47CV 1.88
M_ST32TA M_ST32TA M_ST32TA 8.12
M_ST60TS M_ST60TS M_ST60TS 4.09
M_ST56TS M_ST56TS M_ST56TS 2.72
M_ST43TA M_ST43TA M_ST43TA 2.80
M_ST39CV M_ST39CV M_ST39CV 2.94
M_ST13TS M_ST13TS M_ST13TS 4.64
M_ST60TA M_ST60TA M_ST60TA 7.09
RD_ST35TA RD_ST35TA RD_ST35TA 3.69
M_ST40CV M_ST40CV M_ST40CV 7.68
RD_ST66SV RD_ST66SV RD_ST66SV 3.11
M_ST45TS M_ST45TS M_ST45TS 4.17
M_ST32SA M_ST32SA M_ST32SA 5.60
M_ST26TA M_ST26TA M_ST26TA 7.42
RD_ST55TA RD_ST55TA RD_ST55TA 3.54
ST5SV ST5SV ST5SV 4.92
M_ST26CV M_ST26CV M_ST26CV 7.48
M_ST58TA M_ST58TA M_ST58TA 7.35
M_ST40TA M_ST40TA M_ST40TA 7.16
M_ST40TS M_ST40TS M_ST40TS 2.02
M_ST21SV M_ST21SV M_ST21SV 6.20
M_ST35SA M_ST35SA M_ST35SA 2.73
M_ST15TA M_ST15TA M_ST15TA 6.07
M_ST54CV M_ST54CV M_ST54CV 1.75

prBin <- predictionStats_binary(cbind(TADPOLE_DX_TEST$DX,predict(bDXml,TADPOLE_DX_TEST)),"MCI vs Dementia")

MCI vs Dementia

pander::pander(prBin$aucs)
est lower upper
0.792 0.742 0.841
pander::pander(prBin$accc)
est lower upper
0.713 0.665 0.758
pander::pander(prBin$berror)
50% 2.5% 97.5%
0.31 0.261 0.367
pander::pander(prBin$sensitivity)
est lower upper
0.643 0.54 0.737
par(op)

3.0.3 The formula network

cmax <- apply(bDXml$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bDXml$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=10*E(gr)$weight,
     vertex.size=10*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="MCI vs Dementia Diagnosis")

par(op)

3.0.4 MCI vs AD table


clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableMCI_De <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "OR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableMCI_De$Cluster <- nugget[rownames(tableMCI_De)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableMCI_De$Description <- description[rownames(tableMCI_De)]
pander::pander(tableMCI_De)
  Estimate lower OR upper full.AUC DeltaAUC z.IDI Frequency Cluster Description
M_ST24TA -48.263 1.01e-24 1.10e-21 1.19e-18 0.757 0.06716 10.63 1.00 1 Cortical Thickness Average of LeftEntorhinal
M_ST32CV -17.997 1.96e-10 1.53e-08 1.19e-06 0.757 0.03094 6.92 1.00 1 Volume (Cortical Parcellation) of LeftInferiorTemporal
M_ST24CV -27.345 1.26e-14 1.33e-12 1.41e-10 0.745 0.05146 9.01 1.00 2 Volume (Cortical Parcellation) of LeftEntorhinal
M_ST46TS 151.043 2.49e+41 3.95e+65 6.29e+89 0.756 0.01183 5.07 1.00 1 Cortical Thickness Standard Deviation of LeftParsOrbitalis
M_ST31CV -10.484 1.52e-06 2.80e-05 5.16e-04 0.740 0.02480 6.36 0.75 1 Volume (Cortical Parcellation) of LeftInferiorParietal
M_ST30SV 4.199 1.71e+01 6.66e+01 2.59e+02 0.738 0.02072 5.63 1.00 2 Volume (WM Parcellation) of LeftInferiorLateralVentricle
M_ST24SA 6.624 6.07e+01 7.53e+02 9.35e+03 0.743 0.00762 4.85 0.75 2 Surface Area of LeftEntorhinal
Hippocampus -14.025 6.53e-08 8.11e-07 1.01e-05 0.726 0.04313 8.96 0.90 3 NA
RD_ST52TA 1.761 2.96e+00 5.82e+00 1.14e+01 0.735 0.00859 5.05 0.85 2 Cortical Thickness Average of LeftPrecuneus
M_ST43TS 151.462 2.65e+38 6.01e+65 1.37e+93 0.739 0.00776 4.55 1.00 2 Cortical Thickness Standard Deviation of LeftParacentral
M_ST12SV -20.770 1.36e-11 9.54e-10 6.69e-08 0.731 0.03630 7.66 0.90 3 Volume (WM Parcellation) of LeftAmygdala
RD_ST32TA 0.965 1.81e+00 2.62e+00 3.79e+00 0.732 0.01723 5.00 0.70 3 Cortical Thickness Average of LeftInferiorTemporal
M_ST129TS 40.276 3.94e+10 3.10e+17 2.45e+24 0.728 0.00473 4.87 0.40 4 Cortical Thickness Standard Deviation of LeftInsula
M_ST47CV 3.612 7.90e+00 3.70e+01 1.74e+02 0.733 0.01282 4.49 0.30 1 Volume (Cortical Parcellation) of LeftParsTriangularis
M_ST32TA -68.352 6.65e-37 2.07e-30 6.42e-24 0.728 0.02254 7.46 0.95 3 Cortical Thickness Average of LeftInferiorTemporal
M_ST60TS 48.891 5.52e+13 1.71e+21 5.31e+28 0.724 0.01475 5.47 0.60 3 Cortical Thickness Standard Deviation of LeftTemporalPole
M_ST39CV 5.651 2.87e+01 2.85e+02 2.82e+03 0.735 0.01239 4.73 0.45 5 Volume (Cortical Parcellation) of LeftMedialOrbitofrontal
M_ST13TS 107.209 4.04e+29 3.63e+46 3.27e+63 0.723 0.00859 5.31 0.65 3 Cortical Thickness Standard Deviation of LeftBankssts
M_ST60TA -23.861 2.25e-13 4.34e-11 8.36e-09 0.718 0.03383 7.50 0.70 4 Cortical Thickness Average of LeftTemporalPole
RD_ST35TA 1.302 2.23e+00 3.68e+00 6.06e+00 0.723 0.01661 4.99 0.75 4 Cortical Thickness Average of LeftLateralOccipital
M_ST40CV -7.280 1.28e-04 6.90e-04 3.71e-03 0.719 0.03314 7.09 0.60 4 Volume (Cortical Parcellation) of LeftMiddleTemporal
RD_ST66SV -0.424 5.33e-01 6.55e-01 8.04e-01 0.735 0.00623 3.92 0.55 5 Volume (WM Parcellation) of LeftVessel
M_ST32SA -2.607 3.75e-02 7.37e-02 1.45e-01 0.725 0.03450 6.52 0.60 5 Surface Area of LeftInferiorTemporal
M_ST26CV -1.809 7.47e-02 1.64e-01 3.59e-01 0.723 0.01140 4.34 0.25 5 Volume (Cortical Parcellation) of LeftFusiform
M_ST40TA -28.750 6.76e-16 3.27e-13 1.58e-10 0.727 0.03978 7.36 0.45 5 Cortical Thickness Average of LeftMiddleTemporal

3.1 Decorrelating the sets


TADPOLE_DX_TRAIND <- GDSTMDecorrelation(TADPOLE_DX_TRAIN,Outcome="DX",
                                        thr=0.6,
                                        type="RLM",
                                        method="spearman",
                                        verbose = TRUE)
#> 
#>  Included: 196 , Uni p: 0.01242039 To Outcome: 97 , Base: 4 , In Included: 4 , Base Cor: 14 
#> 1 , Top: 38 < 0.6 >( 4 )[ 1 : 0 : 0.594 ]( 37 , 94 , 0 ),<>Tot Used: 131 , Added: 94 , Zero Std: 0 , Max Cor: 0.9891429 
#> 2 , Top: 29 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0.594 ]( 27 , 35 , 37 ),<>Tot Used: 152 , Added: 35 , Zero Std: 0 , Max Cor: 0.9245065 
#> 3 , Top: 17 < 0.6 >( 2 )[ 1 : 0 : 0.594 ]( 17 , 18 , 60 ),<>Tot Used: 154 , Added: 18 , Zero Std: 0 , Max Cor: 0.8463234 
#> 4 , Top: 7 < 0.6 >[ TRUE ]( 1 )[ 1 : 0 : 0 ]( 7 , 8 , 74 ),<>Tot Used: 155 , Added: 8 , Zero Std: 0 , Max Cor: 0.8906106 
#> 5 , Top: 3 < 0.6 >( 1 )[ 1 : 0 : 0 ]( 3 , 3 , 77 ),<>Tot Used: 155 , Added: 3 , Zero Std: 0 , Max Cor: 0.6520013 
#> 6 , Top: 1 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0.6 ]( 1 , 1 , 79 ),<>Tot Used: 155 , Added: 1 , Zero Std: 0 , Max Cor: 0.5983268 
#> [ 7 ], 0.5980715 . Cor to Base: 100 , ABase: 67
TADPOLE_DX_TESTD <-  predictDecorrelate(TADPOLE_DX_TRAIND,TADPOLE_DX_TEST)

3.1.1 Decorrelated ML

bDXmlD <- BSWiMS.model(DX~.,TADPOLE_DX_TRAIND,NumberofRepeats = 20)

[+++-+++-+++—+++-+++-+++-+++-+++-+++-+++-+++-++—+++-+++-+++-+++-+++-+++-+++–+++-]…..

pander::pander(bDXmlD$bagging$Jaccard.SM)

0.25


fs <- bDXmlD$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bDXmlD)
pander::pander(sm$coefficients)
  Estimate lower OR upper u.Accuracy r.Accuracy full.Accuracy u.AUC r.AUC full.AUC IDI NRI z.IDI z.NRI Frequency
Ba_M_ST24TA -105.423 5.68e-53 1.64e-46 4.75e-40 0.727 0.620 0.743 0.724 0.598 0.741 0.2337 0.903 16.20 14.81 1.00
De_M_ST11SV -263.716 3.51e-142 2.95e-115 2.48e-88 0.659 0.707 0.733 0.653 0.692 0.730 0.0542 0.402 7.12 6.05 1.00
Ba_M_ST31TA -103.989 5.07e-57 6.89e-46 9.35e-35 0.651 0.711 0.735 0.639 0.705 0.733 0.0535 0.447 6.77 6.73 1.00
De_M_ST30SV 15.914 1.13e+05 8.15e+06 5.87e+08 0.637 0.706 0.736 0.622 0.707 0.733 0.0482 0.406 6.55 6.08 1.00
M_ST21SV 23.969 2.60e+07 2.57e+10 2.53e+13 0.615 0.696 0.718 0.613 0.692 0.720 0.0453 0.386 6.42 5.75 0.85
M_ST35CV -5.666 5.20e-04 3.46e-03 2.31e-02 0.639 0.695 0.722 0.641 0.699 0.724 0.0373 0.449 5.71 6.75 0.35
Ba_M_ST32SA -4.706 1.77e-03 9.04e-03 4.63e-02 0.626 0.693 0.718 0.618 0.695 0.720 0.0343 0.454 5.56 6.84 0.85
M_ST55CV -2.676 2.65e-02 6.88e-02 1.79e-01 0.629 0.695 0.720 0.617 0.697 0.719 0.0342 0.388 5.40 5.78 0.15
RD_ST35TA 1.692 2.97e+00 5.43e+00 9.93e+00 0.626 0.706 0.719 0.600 0.711 0.718 0.0321 0.428 5.38 6.43 0.50
De_M_ST57CV 56.470 4.36e+15 3.35e+24 2.57e+33 0.556 0.702 0.716 0.565 0.703 0.717 0.0330 0.411 5.33 6.16 0.70
M_ST60TS 35.030 2.48e+09 1.63e+15 1.08e+21 0.618 0.696 0.719 0.612 0.696 0.719 0.0266 0.332 5.04 4.94 0.25
RD_ST55TA 0.611 1.45e+00 1.84e+00 2.35e+00 0.624 0.747 0.758 0.592 0.740 0.749 0.0282 0.393 4.90 5.93 0.10
RD_ST32TA 2.715 5.33e+00 1.51e+01 4.28e+01 0.644 0.717 0.733 0.610 0.708 0.730 0.0268 0.349 4.86 5.23 1.00
De_M_ST43TA 129.290 6.80e+33 1.41e+56 2.93e+78 0.556 0.741 0.743 0.553 0.744 0.741 0.0293 0.304 4.84 4.50 1.00
M_ST49CV -3.730 5.19e-03 2.40e-02 1.11e-01 0.586 0.702 0.716 0.603 0.703 0.718 0.0258 0.327 4.66 4.86 0.25
RD_ST52TA 4.860 1.65e+01 1.29e+02 1.01e+03 0.607 0.727 0.741 0.553 0.729 0.740 0.0269 0.215 4.56 3.24 1.00
M_ST46TS 127.575 2.01e+31 2.54e+55 3.21e+79 0.572 0.716 0.742 0.551 0.709 0.740 0.0231 0.328 4.40 4.89 0.75
RD_ST66SV -0.768 3.28e-01 4.64e-01 6.55e-01 0.523 0.708 0.721 0.578 0.713 0.722 0.0213 0.352 4.25 5.37 0.80
De_M_ST37SV -51.165 3.33e-34 6.02e-23 1.09e-11 0.569 0.708 0.719 0.516 0.710 0.721 0.0163 0.296 3.77 4.43 0.70
pander::pander(bDXmlD$univariate[bDXmlD$selectedfeatures,])
  Name RName ZUni
Ba_M_ST24TA Ba_M_ST24TA Ba_M_ST24TA 10.60
De_M_ST43TA De_M_ST43TA De_M_ST43TA 3.64
RD_ST55TA RD_ST55TA RD_ST55TA 3.54
RD_ST52TA RD_ST52TA RD_ST52TA 4.44
De_M_ST30SV De_M_ST30SV De_M_ST30SV 6.96
De_M_ST11SV De_M_ST11SV De_M_ST11SV 6.91
Ba_M_ST31TA Ba_M_ST31TA Ba_M_ST31TA 6.77
RD_ST32TA RD_ST32TA RD_ST32TA 4.42
M_ST46TS M_ST46TS M_ST46TS 2.35
M_ST21SV M_ST21SV M_ST21SV 6.20
RD_ST35TA RD_ST35TA RD_ST35TA 3.69
M_ST60TS M_ST60TS M_ST60TS 4.09
Ba_M_ST32SA Ba_M_ST32SA Ba_M_ST32SA 5.60
M_ST13TS M_ST13TS M_ST13TS 4.64
M_ST35SA M_ST35SA M_ST35SA 2.73
M_ST35CV M_ST35CV M_ST35CV 5.79
RD_ST66SV RD_ST66SV RD_ST66SV 3.11
De_M_ST37SV De_M_ST37SV De_M_ST37SV 2.07
M_ST55CV M_ST55CV M_ST55CV 5.67
De_M_ST57CV De_M_ST57CV De_M_ST57CV 2.55
M_ST49CV M_ST49CV M_ST49CV 5.18

prBin <- predictionStats_binary(cbind(TADPOLE_DX_TESTD$DX,predict(bDXmlD,TADPOLE_DX_TESTD)),"MCI vs Dementia")

MCI vs Dementia

pander::pander(prBin$aucs)
est lower upper
0.796 0.747 0.846
pander::pander(prBin$accc)
est lower upper
0.713 0.665 0.758
pander::pander(prBin$berror)
50% 2.5% 97.5%
0.3 0.248 0.352
pander::pander(prBin$sensitivity)
est lower upper
0.673 0.571 0.765
par(op)

3.1.2 The formula network

cmax <- apply(bDXmlD$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bDXmlD$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=10*E(gr)$weight,
     vertex.size=10*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="MCI vs Dementia Diagnosis")

par(op)

3.1.3 Decorrelated MCI vs AD table


clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableMCI_DeD <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "OR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableMCI_DeD$Cluster <- nugget[rownames(tableMCI_DeD)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableMCI_DeD$Description <- description[rownames(tableMCI_DeD)]



## Getting the decorrelation formula
dc <- getDerivedCoefficients(TADPOLE_DX_TRAIND)
decornames <- rownames(sm$coefficients)

deNames_in_dc <- decornames[decornames %in% names(dc)]
theDeFormulas <- dc[deNames_in_dc]
deFromula <- character(length(theDeFormulas))
names(deFromula) <- names(theDeFormulas)
for (dx in names(deFromula))
{
  coef <- theDeFormulas[[dx]]
  cname <- names(theDeFormulas[[dx]])
  names(cname) <- cname
  for (cf in names(coef))
  {
    if (cf != dx)
    {
      if (coef[cf]>0)
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("+ %5.3f*%s",coef[cf],cname[cf]))
      }
      else
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("%5.3f*%s",coef[cf],cname[cf]))
      }
    }
  }
}

tableMCI_DeD$DecorFormula <- deFromula[rownames(tableMCI_DeD)]



pander::pander(tableMCI_DeD)
  Estimate lower OR upper full.AUC DeltaAUC z.IDI Frequency Cluster Description DecorFormula
Ba_M_ST24TA -105.423 5.68e-53 1.64e-46 4.75e-40 0.741 0.14354 16.20 1.00 1 Cortical Thickness Average of LeftEntorhinal NA
De_M_ST43TA 129.290 6.80e+33 1.41e+56 2.93e+78 0.741 -0.00276 4.84 1.00 1 Cortical Thickness Average of LeftParacentral -0.755M_ST31TA + 1.000M_ST43TA
RD_ST52TA 4.860 1.65e+01 1.29e+02 1.01e+03 0.740 0.01033 4.56 1.00 1 Cortical Thickness Average of LeftPrecuneus NA
De_M_ST30SV 15.914 1.13e+05 8.15e+06 5.87e+08 0.733 0.02628 6.55 1.00 2 Volume (WM Parcellation) of LeftInferiorLateralVentricle -0.320Ventricles + 1.000M_ST30SV
De_M_ST11SV -263.716 3.51e-142 2.95e-115 2.48e-88 0.730 0.03792 7.12 1.00 2 Volume (WM Parcellation) of LeftAccumbensArea + 0.000ICV + 1.000M_ST11SV
Ba_M_ST31TA -103.989 5.07e-57 6.89e-46 9.35e-35 0.733 0.02895 6.77 1.00 2 Cortical Thickness Average of LeftInferiorParietal NA
RD_ST32TA 2.715 5.33e+00 1.51e+01 4.28e+01 0.730 0.02186 4.86 1.00 2 Cortical Thickness Average of LeftInferiorTemporal NA
M_ST46TS 127.575 2.01e+31 2.54e+55 3.21e+79 0.740 0.03100 4.40 0.75 2 Cortical Thickness Standard Deviation of LeftParsOrbitalis NA
M_ST21SV 23.969 2.60e+07 2.57e+10 2.53e+13 0.720 0.02734 6.42 0.85 3 Volume (WM Parcellation) of LeftChoroidPlexus NA
RD_ST35TA 1.692 2.97e+00 5.43e+00 9.93e+00 0.718 0.00748 5.38 0.50 3 Cortical Thickness Average of LeftLateralOccipital NA
M_ST60TS 35.030 2.48e+09 1.63e+15 1.08e+21 0.719 0.02247 5.04 0.25 3 Cortical Thickness Standard Deviation of LeftTemporalPole NA
Ba_M_ST32SA -4.706 1.77e-03 9.04e-03 4.63e-02 0.720 0.02469 5.56 0.85 3 Surface Area of LeftInferiorTemporal NA
M_ST35CV -5.666 5.20e-04 3.46e-03 2.31e-02 0.724 0.02533 5.71 0.35 3 Volume (Cortical Parcellation) of LeftLateralOccipital NA
RD_ST66SV -0.768 3.28e-01 4.64e-01 6.55e-01 0.722 0.00936 4.25 0.80 3 Volume (WM Parcellation) of LeftVessel NA
De_M_ST37SV -51.165 3.33e-34 6.02e-23 1.09e-11 0.721 0.01143 3.77 0.70 3 Volume (WM Parcellation) of LeftLateralVentricle -0.821Ventricles + 0.142M_ST30SV + 1.000*M_ST37SV
De_M_ST57CV 56.470 4.36e+15 3.35e+24 2.57e+33 0.717 0.01370 5.33 0.70 3 Volume (Cortical Parcellation) of LeftSuperiorParietal -0.080M_ST31TA -4.580M_ST57TA -0.187M_ST57SA + 1.000M_ST57CV
M_ST49CV -3.730 5.19e-03 2.40e-02 1.11e-01 0.718 0.01460 4.66 0.25 3 Volume (Cortical Parcellation) of LeftPostcentral NA

4 Diagnosis NL vs AD

4.0.1 the set

TrainFraction <- 0.60;

table(validBaselineTadpole$DX)

Dementia MCI NL 244 711 452


TADPOLECrossMRI <- subset(validBaselineTadpole,DX == "Dementia" | DX == "NL")
table(TADPOLECrossMRI$DX)

Dementia MCI NL 244 0 452


TADPOLECrossMRI$DX <- 1*(as.character(TADPOLECrossMRI$DX) == "Dementia")
table(TADPOLECrossMRI$DX)

0 1 452 244

TADPOLECrossMRI$ADAS13 <- NULL
TADPOLECrossMRI$ADAS11 <- NULL
TADPOLECrossMRI$MMSE <- NULL
TADPOLECrossMRI$RAVLT_immediate <- NULL
TADPOLECrossMRI$RAVLT_learning <- NULL
TADPOLECrossMRI$RAVLT_perc_forgetting <- NULL
TADPOLECrossMRI$RAVLT_forgetting <- NULL
TADPOLECrossMRI$FAQ <- NULL

TADPOLE_Cases <- subset(TADPOLECrossMRI,DX==1)
TADPOLE_Controls <- subset(TADPOLECrossMRI,DX==0)
trainCasesSet <- sample(nrow(TADPOLE_Cases),nrow(TADPOLE_Cases)*TrainFraction)
trainControlSet <- sample(nrow(TADPOLE_Controls),nrow(TADPOLE_Controls)*TrainFraction)

TADPOLE_DX_NLDE_TRAIN <- rbind(TADPOLE_Cases[trainCasesSet,],TADPOLE_Controls[trainControlSet,])
TADPOLE_DX_NLDE_TEST <- TADPOLECrossMRI[!(rownames(TADPOLECrossMRI) %in% rownames(TADPOLE_DX_NLDE_TRAIN)),]


pander::pander(table(TADPOLE_DX_NLDE_TRAIN$DX))
0 1
271 146
pander::pander(table(TADPOLE_DX_NLDE_TEST$DX))
0 1
181 98


par(op)

4.0.2 Learning

bDXmlNLDE <- BSWiMS.model(DX~.,TADPOLE_DX_NLDE_TRAIN,NumberofRepeats = 20)

[++++–++–+++-+++++-+++-+++-+-+++-+++-+++-++–++–+—++++-+++-++–++-+-+++-+–+++++-++-]…..

pander::pander(bDXmlNLDE$bagging$Jaccard.SM)

0.162


fs <- bDXmlNLDE$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bDXmlNLDE)
pander::pander(sm$coefficients)
  Estimate lower OR upper u.Accuracy r.Accuracy full.Accuracy u.AUC r.AUC full.AUC IDI NRI z.IDI z.NRI Frequency
M_ST24CV -126.5779 6.26e-64 1.07e-55 1.82e-47 0.826 0.826 0.896 0.824 0.825 0.893 0.1686 1.016 10.95 14.22 0.90
M_ST40TA -285.7177 2.12e-146 8.21e-125 3.18e-103 0.793 0.826 0.878 0.783 0.825 0.878 0.1338 0.963 9.11 13.19 0.55
M_ST31TA -49.7253 4.68e-28 2.54e-22 1.38e-16 0.724 0.819 0.854 0.715 0.814 0.851 0.0832 0.808 7.37 10.36 0.15
M_ST12SV -70.9568 5.93e-38 1.53e-31 3.93e-25 0.800 0.860 0.889 0.797 0.858 0.888 0.0721 0.619 6.60 7.92 0.70
M_ST43TA 27.9320 1.52e+09 1.35e+12 1.20e+15 0.582 0.829 0.848 0.566 0.823 0.844 0.0728 0.645 6.60 7.97 0.10
M_ST24TA -71.8333 1.53e-41 6.36e-32 2.64e-22 0.849 0.893 0.908 0.841 0.891 0.905 0.0596 0.632 6.11 7.84 1.00
Hippocampus -32.2588 4.61e-19 9.78e-15 2.07e-10 0.835 0.875 0.908 0.828 0.871 0.905 0.0563 0.544 5.96 6.67 1.00
M_ST32TA -89.7553 7.83e-50 1.05e-39 1.40e-29 0.815 0.842 0.874 0.807 0.841 0.873 0.0675 0.594 5.89 7.52 0.35
M_ST36CV 60.0446 1.63e+17 1.19e+26 8.77e+34 0.608 0.889 0.910 0.603 0.888 0.908 0.0441 0.562 5.51 6.95 1.00
M_ST32CV -24.0787 1.06e-14 3.49e-11 1.14e-07 0.769 0.861 0.877 0.760 0.857 0.876 0.0512 0.632 5.28 7.94 0.50
M_ST31CV -26.4590 1.68e-16 3.23e-12 6.21e-08 0.717 0.897 0.910 0.710 0.894 0.908 0.0404 0.460 5.16 5.60 0.70
M_ST51TA 62.0353 1.28e+17 8.74e+26 5.95e+36 0.597 0.865 0.879 0.581 0.863 0.875 0.0502 0.650 5.12 8.25 0.25
M_ST60TA -12.5257 2.58e-08 3.63e-06 5.12e-04 0.744 0.832 0.854 0.739 0.829 0.851 0.0421 0.535 4.90 6.52 0.15
M_ST24SA 27.9763 2.30e+07 1.41e+12 8.66e+16 0.595 0.886 0.897 0.604 0.883 0.893 0.0367 0.538 4.84 6.67 0.85
M_ST39CV 23.5529 1.54e+06 1.69e+10 1.87e+14 0.580 0.864 0.879 0.577 0.864 0.879 0.0381 0.416 4.84 5.01 0.55
RD_ST32TA 4.5975 1.62e+01 9.92e+01 6.07e+02 0.686 0.888 0.908 0.668 0.885 0.905 0.0403 0.565 4.83 6.99 1.00
RD_ST29SV 5.1023 2.02e+01 1.64e+02 1.34e+03 0.664 0.864 0.878 0.639 0.864 0.879 0.0372 0.744 4.67 9.60 0.35
M_ST30SV 18.1771 3.65e+04 7.84e+07 1.68e+11 0.765 0.876 0.890 0.760 0.874 0.888 0.0365 0.531 4.50 6.52 0.80
M_ST44CV -12.8990 9.47e-09 2.50e-06 6.60e-04 0.714 0.851 0.862 0.710 0.848 0.859 0.0358 0.490 4.42 5.99 0.25
M_ST40CV -13.4866 3.87e-09 1.39e-06 4.99e-04 0.756 0.873 0.891 0.753 0.870 0.888 0.0329 0.524 4.38 6.37 0.35
M_ST32SA -2.7298 1.87e-02 6.52e-02 2.28e-01 0.645 0.867 0.873 0.642 0.862 0.871 0.0318 0.467 4.18 5.63 0.20
M_ST45TA 94.8982 3.42e+22 1.64e+41 7.82e+59 0.649 0.867 0.878 0.637 0.868 0.879 0.0328 0.682 4.17 8.58 0.30
M_ST60TS 81.2727 8.39e+18 1.98e+35 4.67e+51 0.621 0.864 0.875 0.615 0.861 0.873 0.0258 0.465 4.13 5.68 0.40
M_ST13CV -18.8357 7.01e-13 6.60e-09 6.22e-05 0.737 0.891 0.896 0.733 0.887 0.892 0.0236 0.287 3.94 3.45 0.40
M_ST40TS 209.4990 8.04e+46 9.64e+90 1.16e+135 0.521 0.862 0.876 0.513 0.861 0.877 0.0283 0.562 3.90 6.95 0.40
M_ST31SA -1.4821 1.06e-01 2.27e-01 4.86e-01 0.617 0.868 0.876 0.615 0.869 0.880 0.0224 0.429 3.76 5.16 0.15
RD_ST39SA -1.1342 1.81e-01 3.22e-01 5.73e-01 0.532 0.882 0.882 0.557 0.879 0.878 0.0265 0.469 3.75 5.68 0.15
RD_ST40TA 4.0553 7.48e+00 5.77e+01 4.45e+02 0.628 0.871 0.883 0.601 0.867 0.878 0.0271 0.403 3.74 4.87 0.55
ST3SV -0.3718 5.70e-01 6.90e-01 8.34e-01 0.625 0.878 0.889 0.627 0.877 0.886 0.0275 0.519 3.73 6.34 0.50
M_ST24TS 18.5224 7.33e+03 1.11e+08 1.67e+12 0.603 0.849 0.855 0.600 0.844 0.852 0.0244 0.426 3.63 5.15 0.10
M_ST13SA -1.0250 2.08e-01 3.59e-01 6.19e-01 0.640 0.892 0.902 0.649 0.889 0.899 0.0180 0.588 3.61 7.26 0.15
ST127SV -0.0347 9.48e-01 9.66e-01 9.84e-01 0.611 0.875 0.887 0.606 0.874 0.884 0.0214 0.419 3.47 5.07 0.20
M_ST60SA 1.9934 2.42e+00 7.34e+00 2.23e+01 0.542 0.888 0.897 0.543 0.885 0.893 0.0180 0.416 3.47 4.98 0.15
RD_ST129SA 0.6783 1.35e+00 1.97e+00 2.88e+00 0.552 0.852 0.858 0.540 0.850 0.856 0.0192 0.428 3.38 5.18 0.10
pander::pander(bDXmlNLDE$univariate[bDXmlNLDE$selectedfeatures,])
  Name RName ZUni
M_ST24TA M_ST24TA M_ST24TA 19.86
Hippocampus Hippocampus Hippocampus 18.92
RD_ST32TA RD_ST32TA RD_ST32TA 7.45
M_ST13SA M_ST13SA M_ST13SA 5.68
M_ST24CV M_ST24CV M_ST24CV 18.12
M_ST36CV M_ST36CV M_ST36CV 5.43
M_ST31CV M_ST31CV M_ST31CV 11.31
M_ST24SA M_ST24SA M_ST24SA 3.85
M_ST13CV M_ST13CV M_ST13CV 11.00
M_ST30SV M_ST30SV M_ST30SV 13.44
M_ST12SV M_ST12SV M_ST12SV 16.29
RD_ST39SA RD_ST39SA RD_ST39SA 2.06
M_ST60SA M_ST60SA M_ST60SA 1.58
M_ST40CV M_ST40CV M_ST40CV 13.69
M_ST32TA M_ST32TA M_ST32TA 14.97
M_ST15TA M_ST15TA M_ST15TA 8.87
RD_ST40TA RD_ST40TA RD_ST40TA 6.14
M_ST32CV M_ST32CV M_ST32CV 14.25
M_ST39CV M_ST39CV M_ST39CV 4.28
M_ST40TA M_ST40TA M_ST40TA 14.37
M_ST40TS M_ST40TS M_ST40TS 1.08
ST3SV ST3SV ST3SV 6.66
M_ST32SA M_ST32SA M_ST32SA 7.26
M_ST31SA M_ST31SA M_ST31SA 5.88
M_ST23CV M_ST23CV M_ST23CV 2.67
M_ST60TS M_ST60TS M_ST60TS 5.19
ST127SV ST127SV ST127SV 5.17
M_ST45TA M_ST45TA M_ST45TA 5.98
RD_ST29SV RD_ST29SV RD_ST29SV 5.88
RD_ST23TA RD_ST23TA RD_ST23TA 1.63
M_ST51TA M_ST51TA M_ST51TA 4.57
M_ST60TA M_ST60TA M_ST60TA 11.05
M_ST44CV M_ST44CV M_ST44CV 10.56
M_ST13TS M_ST13TS M_ST13TS 4.04
M_ST24TS M_ST24TS M_ST24TS 5.33
RD_ST129SA RD_ST129SA RD_ST129SA 1.15
M_ST18SV M_ST18SV M_ST18SV 1.41
M_ST13TA M_ST13TA M_ST13TA 11.70
M_ST40SA M_ST40SA M_ST40SA 6.62
M_ST43TA M_ST43TA M_ST43TA 4.04
M_ST31TA M_ST31TA M_ST31TA 11.19
M_ST47CV M_ST47CV M_ST47CV 3.73
M_ST49TS M_ST49TS M_ST49TS 3.02

prBin <- predictionStats_binary(cbind(TADPOLE_DX_NLDE_TEST$DX,predict(bDXmlNLDE,TADPOLE_DX_NLDE_TEST)),"NL vs Dementia")

NL vs Dementia

pander::pander(prBin$aucs)
est lower upper
0.939 0.907 0.971
pander::pander(prBin$accc)
est lower upper
0.871 0.826 0.908
pander::pander(prBin$berror)
50% 2.5% 97.5%
0.154 0.111 0.203
pander::pander(prBin$sensitivity)
est lower upper
0.755 0.658 0.836
par(op)

4.0.3 The formula network

cmax <- apply(bDXmlNLDE$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bDXmlNLDE$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=10*E(gr)$weight,
     vertex.size=10*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="NL vs Dementia Diagnosis")

par(op)

4.0.4 NL vs Dementia table


clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableNL_DE <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "OR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableNL_DE$Cluster <- nugget[rownames(tableNL_DE)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableNL_DE$Description <- description[rownames(tableNL_DE)]
pander::pander(tableNL_DE)
  Estimate lower OR upper full.AUC DeltaAUC z.IDI Frequency Cluster Description
M_ST24TA -71.833 1.53e-41 6.36e-32 2.64e-22 0.905 0.01339 6.11 1.00 1 Cortical Thickness Average of LeftEntorhinal
Hippocampus -32.259 4.61e-19 9.78e-15 2.07e-10 0.905 0.03317 5.96 1.00 1 NA
RD_ST32TA 4.598 1.62e+01 9.92e+01 6.07e+02 0.905 0.01967 4.83 1.00 1 Cortical Thickness Average of LeftInferiorTemporal
M_ST24CV -126.578 6.26e-64 1.07e-55 1.82e-47 0.893 0.06773 10.95 0.90 2 Volume (Cortical Parcellation) of LeftEntorhinal
M_ST36CV 60.045 1.63e+17 1.19e+26 8.77e+34 0.908 0.01951 5.51 1.00 1 Volume (Cortical Parcellation) of LeftLateralOrbitofrontal
M_ST31CV -26.459 1.68e-16 3.23e-12 6.21e-08 0.908 0.01418 5.16 0.70 1 Volume (Cortical Parcellation) of LeftInferiorParietal
M_ST24SA 27.976 2.30e+07 1.41e+12 8.66e+16 0.893 0.00982 4.84 0.85 2 Surface Area of LeftEntorhinal
M_ST13CV -18.836 7.01e-13 6.60e-09 6.22e-05 0.892 0.00551 3.94 0.40 2 Volume (Cortical Parcellation) of LeftBankssts
M_ST30SV 18.177 3.65e+04 7.84e+07 1.68e+11 0.888 0.01361 4.50 0.80 2 Volume (WM Parcellation) of LeftInferiorLateralVentricle
M_ST12SV -70.957 5.93e-38 1.53e-31 3.93e-25 0.888 0.02946 6.60 0.70 3 Volume (WM Parcellation) of LeftAmygdala
M_ST40CV -13.487 3.87e-09 1.39e-06 4.99e-04 0.888 0.01827 4.38 0.35 2 Volume (Cortical Parcellation) of LeftMiddleTemporal
M_ST32TA -89.755 7.83e-50 1.05e-39 1.40e-29 0.873 0.03211 5.89 0.35 3 Cortical Thickness Average of LeftInferiorTemporal
RD_ST40TA 4.055 7.48e+00 5.77e+01 4.45e+02 0.878 0.01105 3.74 0.55 2 Cortical Thickness Average of LeftMiddleTemporal
M_ST32CV -24.079 1.06e-14 3.49e-11 1.14e-07 0.876 0.01922 5.28 0.50 3 Volume (Cortical Parcellation) of LeftInferiorTemporal
M_ST39CV 23.553 1.54e+06 1.69e+10 1.87e+14 0.879 0.01519 4.84 0.55 3 Volume (Cortical Parcellation) of LeftMedialOrbitofrontal
M_ST40TA -285.718 2.12e-146 8.21e-125 3.18e-103 0.878 0.05294 9.11 0.55 3 Cortical Thickness Average of LeftMiddleTemporal
M_ST40TS 209.499 8.04e+46 9.64e+90 1.16e+135 0.877 0.01558 3.90 0.40 3 Cortical Thickness Standard Deviation of LeftMiddleTemporal
ST3SV -0.372 5.70e-01 6.90e-01 8.34e-01 0.886 0.00941 3.73 0.50 2 Volume (WM Parcellation) of CorpusCallosumCentral
M_ST60TS 81.273 8.39e+18 1.98e+35 4.67e+51 0.873 0.01193 4.13 0.40 3 Cortical Thickness Standard Deviation of LeftTemporalPole
M_ST45TA 94.898 3.42e+22 1.64e+41 7.82e+59 0.879 0.01132 4.17 0.30 3 Cortical Thickness Average of LeftParsOpercularis
RD_ST29SV 5.102 2.02e+01 1.64e+02 1.34e+03 0.879 0.01484 4.67 0.35 3 Volume (WM Parcellation) of LeftHippocampus
M_ST51TA 62.035 1.28e+17 8.74e+26 5.95e+36 0.875 0.01207 5.12 0.25 2 Cortical Thickness Average of LeftPrecentral
M_ST44CV -12.899 9.47e-09 2.50e-06 6.60e-04 0.859 0.01061 4.42 0.25 2 Volume (Cortical Parcellation) of LeftParahippocampal

4.1 Decorrelated Set

TADPOLE_DX_NLDE_TRAIND <- GDSTMDecorrelation(TADPOLE_DX_NLDE_TRAIN,Outcome="DX",
                                        thr=0.6,
                                        type="RLM",
                                        method="spearman",
                                        verbose = TRUE)
#> 
#>  Included: 194 , Uni p: 0.01163097 To Outcome: 107 , Base: 4 , In Included: 4 , Base Cor: 10 
#> 1 , Top: 38 < 0.6 >( 1 )[ 1 : 0 : 0.594 ]( 37 , 83 , 0 ),<>Tot Used: 120 , Added: 83 , Zero Std: 0 , Max Cor: 0.9951887 
#> 2 , Top: 23 < 0.6 >( 1 )[ 1 : 0 : 0.594 ]( 22 , 32 , 37 ),<>Tot Used: 142 , Added: 32 , Zero Std: 0 , Max Cor: 0.931277 
#> 3 , Top: 20 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0.594 ]( 20 , 24 , 56 ),<>Tot Used: 153 , Added: 24 , Zero Std: 0 , Max Cor: 0.9073379 
#> 4 , Top: 8 < 0.6 >( 1 )[ 1 : 0 : 0.594 ]( 8 , 11 , 71 ),<>Tot Used: 158 , Added: 11 , Zero Std: 0 , Max Cor: 0.7895856 
#> 5 , Top: 6 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0 ]( 6 , 6 , 77 ),<>Tot Used: 162 , Added: 6 , Zero Std: 0 , Max Cor: 0.5965441 
#> [ 6 ], 0.5942904 . Cor to Base: 89 , ABase: 62
TADPOLE_DX_NLDE_TESTD <-  predictDecorrelate(TADPOLE_DX_NLDE_TRAIND,TADPOLE_DX_NLDE_TEST)

4.1.1 Learning



bDXmlNLDED <- BSWiMS.model(DX~.,TADPOLE_DX_NLDE_TRAIND,NumberofRepeats = 20)

[+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-]..

pander::pander(bDXmlNLDED$bagging$Jaccard.SM)

1


fs <- bDXmlNLDED$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bDXmlNLDED)
pander::pander(sm$coefficients)
  Estimate lower OR upper u.Accuracy r.Accuracy full.Accuracy u.AUC r.AUC full.AUC IDI NRI z.IDI z.NRI Frequency
Ba_M_ST24TA -583 7.02e-290 4.03e-254 2.32e-218 0.850 0.684 0.906 0.843 0.674 0.901 0.4849 1.581 23.03 30.44 1
De_M_ST51TA 1966 Inf Inf Inf 0.664 0.870 0.906 0.659 0.867 0.901 0.0922 0.737 7.68 9.36 1
De_Hippocampus -183 9.92e-103 2.82e-80 8.01e-58 0.595 0.884 0.906 0.592 0.879 0.901 0.0703 0.628 6.58 7.79 1
pander::pander(bDXmlNLDED$univariate[bDXmlNLDED$selectedfeatures,])
  Name RName ZUni
Ba_M_ST24TA Ba_M_ST24TA Ba_M_ST24TA 19.86
De_Hippocampus De_Hippocampus De_Hippocampus 4.99
De_M_ST51TA De_M_ST51TA De_M_ST51TA 7.68

prBin <- predictionStats_binary(cbind(TADPOLE_DX_NLDE_TESTD$DX,predict(bDXmlNLDED,TADPOLE_DX_NLDE_TESTD)),"NL vs Dementia")

NL vs Dementia

pander::pander(prBin$aucs)
est lower upper
0.933 0.9 0.967
pander::pander(prBin$accc)
est lower upper
0.896 0.854 0.929
pander::pander(prBin$berror)
50% 2.5% 97.5%
0.116 0.0798 0.158
pander::pander(prBin$sensitivity)
est lower upper
0.837 0.748 0.904
par(op)

4.1.2 The formula network

cmax <- apply(bDXmlNLDED$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bDXmlNLDED$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=10*E(gr)$weight,
     vertex.size=10*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="NL vs Dementia Diagnosis")

par(op)

4.1.3 Decorrelated NL vs Dementia table


clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableNL_DED <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "OR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableNL_DED$Cluster <- nugget[rownames(tableNL_DED)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableNL_DED$Description <- description[rownames(tableNL_DED)]



## Getting the decorrelation formula
dc <- getDerivedCoefficients(TADPOLE_DX_NLDE_TRAIND)
decornames <- rownames(sm$coefficients)

deNames_in_dc <- decornames[decornames %in% names(dc)]
theDeFormulas <- dc[deNames_in_dc]
deFromula <- character(length(theDeFormulas))
names(deFromula) <- names(theDeFormulas)
for (dx in names(deFromula))
{
  coef <- theDeFormulas[[dx]]
  cname <- names(theDeFormulas[[dx]])
  names(cname) <- cname
  for (cf in names(coef))
  {
    if (cf != dx)
    {
      if (coef[cf]>0)
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("+ %5.3f*%s",coef[cf],cname[cf]))
      }
      else
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("%5.3f*%s",coef[cf],cname[cf]))
      }
    }
  }
}

tableNL_DED$DecorFormula <- deFromula[rownames(tableNL_DED)]



pander::pander(tableNL_DED)
  Estimate lower OR upper full.AUC DeltaAUC z.IDI Frequency Cluster Description DecorFormula
Ba_M_ST24TA -583 7.02e-290 4.03e-254 2.32e-218 0.901 0.2262 23.03 1 1 Cortical Thickness Average of LeftEntorhinal NA
De_Hippocampus -183 9.92e-103 2.82e-80 8.01e-58 0.901 0.0218 6.58 1 1 NA + 1.000Hippocampus -1.694M_ST24TA
De_M_ST51TA 1966 Inf Inf Inf 0.901 0.0335 7.68 1 1 Cortical Thickness Average of LeftPrecentral -0.489M_ST31TA + 1.000M_ST51TA + 0.033M_ST51SA -0.138M_ST51CV

5 Prognosis MCI to AD Conversion

5.1 the set

TrainFraction <- 0.60;

MCIPrognosisIDs <- c(MCIconverters$PTID,MCI_No_converters$PTID)

TADPOLECrossMRI <- validBaselineTadpole[MCIPrognosisIDs,]
table(TADPOLECrossMRI$DX)

Dementia MCI NL 0 680 0

TADPOLECrossMRI$DX <- NULL
TADPOLECrossMRI$status <- 1*(rownames(TADPOLECrossMRI) %in% MCIconverters$PTID)
table(TADPOLECrossMRI$status)

0 1 436 244

TADPOLECrossMRI$TimeToEvent <- numeric(nrow(TADPOLECrossMRI))
TADPOLECrossMRI[MCIconverters$PTID,"TimeToEvent"] <- MCIconverters$TimeToEvent
TADPOLECrossMRI[MCI_No_converters$PTID,"TimeToEvent"] <- MCI_No_converters$TimeToEvent

TADPOLE_Cases <- subset(TADPOLECrossMRI,status==1)
TADPOLE_Controls <- subset(TADPOLECrossMRI,status==0)
trainCasesSet <- sample(nrow(TADPOLE_Cases),nrow(TADPOLE_Cases)*TrainFraction)
trainControlSet <- sample(nrow(TADPOLE_Controls),nrow(TADPOLE_Controls)*TrainFraction)

TADPOLE_Conv_TRAIN <- rbind(TADPOLE_Cases[trainCasesSet,],TADPOLE_Controls[trainControlSet,])
TADPOLE_Conv_TEST <- TADPOLECrossMRI[!(rownames(TADPOLECrossMRI) %in%
                                         rownames(TADPOLE_Conv_TRAIN)),]

pander::pander(table(TADPOLE_Conv_TRAIN$status))
0 1
261 146
pander::pander(table(TADPOLE_Conv_TEST$status))
0 1
175 98
par(op)

5.1.1 Learning

bConvml <- BSWiMS.model(Surv(TimeToEvent,status)~1,TADPOLE_Conv_TRAIN,NumberofRepeats = 20)

[++–++-++-++—++-++-++-++—++-++-++-++-++-++-++-++-++-++-+++–++—]….

pander::pander(bConvml$bagging$Jaccard.SM)

0.303


fs <- bConvml$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bConvml)
pander::pander(sm$coefficients)
  Estimate lower HR upper u.Accuracy r.Accuracy full.Accuracy u.AUC r.AUC full.AUC IDI NRI z.IDI z.NRI Frequency
FAQ 0.05263 1.04e+00 1.05e+00 1.07e+00 0.727 0.747 0.773 0.691 0.754 0.776 0.04434 0.566 6.47 7.12 1.00
ADAS13 0.05239 1.04e+00 1.05e+00 1.07e+00 0.710 0.763 0.773 0.709 0.765 0.776 0.04892 0.469 5.95 5.56 1.00
M_ST12SV -28.54614 2.77e-17 4.00e-13 5.78e-09 0.716 0.746 0.764 0.713 0.748 0.769 0.02954 0.492 5.53 5.85 1.00
ADAS11 0.04839 1.03e+00 1.05e+00 1.07e+00 0.688 0.720 0.751 0.679 0.729 0.756 0.04085 0.449 5.42 5.34 1.00
RAVLT_perc_forgetting 0.00478 1.00e+00 1.00e+00 1.01e+00 0.658 0.760 0.754 0.664 0.759 0.757 0.02945 0.447 4.78 5.27 0.90
M_ST29SV -14.56677 1.62e-09 4.72e-07 1.38e-04 0.707 0.746 0.755 0.704 0.748 0.758 0.01957 0.320 4.36 3.74 0.85
RD_ST31TA 2.30138 3.62e+00 9.99e+00 2.76e+01 0.613 0.772 0.773 0.587 0.776 0.777 0.01551 0.373 4.36 4.42 0.65
M_ST40CV -11.34356 7.50e-08 1.18e-05 1.87e-03 0.711 0.748 0.758 0.702 0.751 0.761 0.01683 0.306 4.29 3.56 0.95
M_ST40SA -1.03616 2.24e-01 3.55e-01 5.63e-01 0.655 0.739 0.750 0.650 0.745 0.756 0.01636 0.358 4.27 4.18 0.20
RAVLT_immediate -0.01992 9.72e-01 9.80e-01 9.89e-01 0.655 0.769 0.765 0.672 0.770 0.771 0.02467 0.426 4.19 5.02 1.00
RD_ST49SA -1.91809 5.61e-02 1.47e-01 3.85e-01 0.500 0.751 0.752 0.521 0.756 0.758 0.01281 0.242 3.73 2.85 0.70
M_ST44TS 17.15271 5.00e+03 2.81e+07 1.58e+11 0.548 0.752 0.759 0.553 0.761 0.770 0.01408 0.364 3.67 4.28 0.15
M_ST14TS 5.16485 8.09e+00 1.75e+02 3.79e+03 0.606 0.747 0.746 0.595 0.749 0.748 0.00897 0.238 3.23 2.75 0.10
pander::pander(bConvml$univariate[bConvml$selectedfeatures,])
  Name RName ZUni
ADAS13 ADAS13 ADAS13 11.37
FAQ FAQ FAQ 8.88
M_ST39SA M_ST39SA M_ST39SA 6.29
M_ST12SV M_ST12SV M_ST12SV 10.17
RD_ST31TA RD_ST31TA RD_ST31TA 3.78
RAVLT_immediate RAVLT_immediate RAVLT_immediate 8.89
ADAS11 ADAS11 ADAS11 9.90
M_ST56SA M_ST56SA M_ST56SA 4.74
M_ST29SV M_ST29SV M_ST29SV 9.88
M_ST40CV M_ST40CV M_ST40CV 9.70
RAVLT_perc_forgetting RAVLT_perc_forgetting RAVLT_perc_forgetting 7.89
M_ST14TS M_ST14TS M_ST14TS 5.30
M_ST59SA M_ST59SA M_ST59SA 3.64
M_ST59CV M_ST59CV M_ST59CV 7.06
M_ST40SA M_ST40SA M_ST40SA 6.75
RD_ST49TA RD_ST49TA RD_ST49TA 2.08
RD_ST49SA RD_ST49SA RD_ST49SA 2.15
RAVLT_learning RAVLT_learning RAVLT_learning 6.31
M_ST44TS M_ST44TS M_ST44TS 2.45

ptestl <- predict(bConvml,TADPOLE_Conv_TEST,type="lp")
boxplot(ptestl~TADPOLE_Conv_TEST$status)

ptestr <- predict(bConvml,TADPOLE_Conv_TEST,type="risk")
eventCases <- subset(TADPOLE_Conv_TEST,status==1)
plot(1.0/ptestr[rownames(eventCases)]~eventCases$TimeToEvent)

pander::pander(cor.test(eventCases$TimeToEvent,1.0/ptestr[rownames(eventCases)],method="spearman"))
Spearman’s rank correlation rho: eventCases$TimeToEvent and 1/ptestr[rownames(eventCases)]
Test statistic P value Alternative hypothesis rho
104589 0.000801 * * * two.sided 0.333



perdsurv <- cbind(TADPOLE_Conv_TEST$TimeToEvent,
                  TADPOLE_Conv_TEST$status,
                  ptestl,
                  ptestr)
prSurv <- predictionStats_survival(perdsurv,"MCI to  AD Conversion")

pander::pander(prSurv$CIRisk)
median lower upper
0.818 0.775 0.858
pander::pander(prSurv$CILp)
median lower upper
0.837 0.786 0.882
pander::pander(prSurv$spearmanCI)
50% 2.5% 97.5%
0.336 0.127 0.517

prBin <- predictionStats_binary(cbind(TADPOLE_Conv_TEST$status,ptestl),"MCI to  AD Conversion")

MCI to AD Conversion

pander::pander(prBin$aucs)
est lower upper
0.836 0.787 0.885
pander::pander(prBin$CM.analysis$tab)
  Outcome + Outcome - Total
Test + 78 48 126
Test - 20 127 147
Total 98 175 273

par(op)

5.1.2 The formula network

cmax <- apply(bConvml$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bConvml$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=5*E(gr)$weight,
     vertex.size=20*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="MCI to Dementia Conversion")

par(op)

5.1.3 MCI to Dementia table


clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableMCI_to_Dem <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "HR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableMCI_to_Dem$Cluster <- nugget[rownames(tableMCI_to_Dem)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableMCI_to_Dem$Description <- description[rownames(tableMCI_to_Dem)]
pander::pander(tableMCI_to_Dem)
  Estimate lower HR upper full.AUC DeltaAUC z.IDI Frequency Cluster Description
ADAS13 0.05239 1.04e+00 1.05e+00 1.07e+00 0.776 0.01097 5.95 1.00 1 NA
FAQ 0.05263 1.04e+00 1.05e+00 1.07e+00 0.776 0.02207 6.47 1.00 1 NA
M_ST12SV -28.54614 2.77e-17 4.00e-13 5.78e-09 0.769 0.02173 5.53 1.00 1 Volume (WM Parcellation) of LeftAmygdala
RD_ST31TA 2.30138 3.62e+00 9.99e+00 2.76e+01 0.777 0.00118 4.36 0.65 1 Cortical Thickness Average of LeftInferiorParietal
RAVLT_immediate -0.01992 9.72e-01 9.80e-01 9.89e-01 0.771 0.00118 4.19 1.00 1 NA
ADAS11 0.04839 1.03e+00 1.05e+00 1.07e+00 0.756 0.02717 5.42 1.00 2 NA
M_ST29SV -14.56677 1.62e-09 4.72e-07 1.38e-04 0.758 0.01044 4.36 0.85 2 Volume (WM Parcellation) of LeftHippocampus
M_ST40CV -11.34356 7.50e-08 1.18e-05 1.87e-03 0.761 0.00994 4.29 0.95 2 Volume (Cortical Parcellation) of LeftMiddleTemporal
RAVLT_perc_forgetting 0.00478 1.00e+00 1.00e+00 1.01e+00 0.757 -0.00197 4.78 0.90 2 NA
RD_ST49SA -1.91809 5.61e-02 1.47e-01 3.85e-01 0.758 0.00180 3.73 0.70 2 Surface Area of LeftPostcentral

5.2 Decorrelated

TADPOLE_Conv_TRAIND <- GDSTMDecorrelation(TADPOLE_Conv_TRAIN,
                                          Outcome="status",
                                          thr=0.6,
                                          type="RLM",
                                          method="spearman",
                                          verbose = TRUE)
#> 
#>  Included: 209 , Uni p: 0.01153193 To Outcome: 122 , Base: 4 , In Included: 4 , Base Cor: 3 
#> 1 , Top: 44 < 0.6 >( 2 )[ 1 : 0 : 0.594 ]( 43 , 88 , 0 ),<>Tot Used: 131 , Added: 88 , Zero Std: 0 , Max Cor: 0.991806 
#> 2 , Top: 30 < 0.6 >( 1 )[ 1 : 0 : 0.594 ]( 28 , 52 , 43 ),<>Tot Used: 172 , Added: 52 , Zero Std: 0 , Max Cor: 0.903256 
#> 3 , Top: 22 < 0.6 >[ TRUE ]( 1 )[ 1 : 0 : 0.594 ]( 22 , 25 , 66 ),<>Tot Used: 174 , Added: 25 , Zero Std: 0 , Max Cor: 0.9184848 
#> 4 , Top: 10 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0 ]( 10 , 10 , 82 ),<>Tot Used: 175 , Added: 10 , Zero Std: 0 , Max Cor: 0.605463 
#> 5 , Top: 1 < 0.6 >( 1 )[ 1 : 0 : 0.6 ]( 1 , 1 , 90 ),<>Tot Used: 175 , Added: 1 , Zero Std: 0 , Max Cor: 0.6266446 
#> 6 , Top: 1 < 0.6 >( 1 )[ 1 : 0 : 0.6 ]( 1 , 1 , 90 ),<>Tot Used: 175 , Added: 1 , Zero Std: 0 , Max Cor: 0.599695 
#> [ 7 ], 0.5951033 . Cor to Base: 98 , ABase: 77
TADPOLE_Conv_TESTD <-  predictDecorrelate(TADPOLE_Conv_TRAIND,TADPOLE_Conv_TEST)

5.2.1 Learning

bConvmlD <- BSWiMS.model(Surv(TimeToEvent,status)~1,TADPOLE_Conv_TRAIND,NumberofRepeats = 20)

[+-++-++-++-+-++-+-++-++-+–++-++-+–++-+-+-++-+-++-+–]…

pander::pander(bConvmlD$bagging$Jaccard.SM)

0.373


fs <- bConvmlD$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bConvmlD)
pander::pander(sm$coefficients)
  Estimate lower HR upper u.Accuracy r.Accuracy full.Accuracy u.AUC r.AUC full.AUC IDI NRI z.IDI z.NRI Frequency
Ba_ADAS13 0.08875 1.07e+00 1.09e+00 1.11e+00 0.711 0.773 0.780 0.709 0.771 0.782 0.08488 0.622 7.96 7.53 1.00
FAQ 0.07336 1.06e+00 1.08e+00 1.09e+00 0.726 0.749 0.780 0.688 0.754 0.782 0.05194 0.644 7.23 8.15 1.00
Ba_RAVLT_learning -0.05361 9.32e-01 9.48e-01 9.64e-01 0.655 0.717 0.754 0.665 0.713 0.745 0.05653 0.529 5.88 6.37 0.55
De_M_ST40SA -4.45130 2.40e-03 1.17e-02 5.66e-02 0.654 0.720 0.754 0.647 0.712 0.745 0.03724 0.433 5.46 5.09 0.55
De_M_ST32TA -77.26965 1.84e-46 2.77e-34 4.16e-22 0.581 0.743 0.754 0.578 0.729 0.745 0.03777 0.511 5.32 6.07 0.55
De_Hippocampus -23.08759 1.15e-14 9.40e-11 7.71e-07 0.699 0.775 0.780 0.698 0.771 0.782 0.02369 0.438 4.92 5.16 1.00
Ba_RD_ST49SA -2.47656 3.00e-02 8.40e-02 2.35e-01 0.504 0.742 0.754 0.527 0.731 0.745 0.02185 0.312 4.62 3.68 0.55
De_RAVLT_perc_forgetting 0.00748 1.00e+00 1.01e+00 1.01e+00 0.597 0.731 0.754 0.591 0.732 0.745 0.03335 0.363 4.52 4.24 0.55
RD_ST31TA 3.44686 7.26e+00 3.14e+01 1.36e+02 0.616 0.777 0.781 0.588 0.779 0.781 0.01726 0.379 4.52 4.52 0.75
De_M_ST60SA -1.30154 1.51e-01 2.72e-01 4.91e-01 0.606 0.752 0.753 0.605 0.741 0.742 0.01629 0.379 4.22 4.43 0.15
RD_ST65SV -3.93478 3.14e-03 1.95e-02 1.22e-01 0.521 0.766 0.778 0.539 0.771 0.783 0.01668 0.357 4.09 4.19 0.25
De_M_ST48CV -34.43520 1.16e-22 1.11e-15 1.06e-08 0.563 0.774 0.779 0.558 0.774 0.779 0.01046 0.220 4.07 2.56 0.75
Ba_M_ST56SA -1.18349 1.70e-01 3.06e-01 5.53e-01 0.571 0.770 0.784 0.576 0.776 0.790 0.01844 0.251 3.84 2.91 0.15
De_RAVLT_immediate -0.01446 9.78e-01 9.86e-01 9.93e-01 0.542 0.788 0.776 0.546 0.786 0.780 0.02017 0.428 3.77 5.03 0.40
RD_ST59TA 0.37117 1.17e+00 1.45e+00 1.79e+00 0.559 0.757 0.753 0.536 0.750 0.746 0.00971 0.242 3.25 2.84 0.15
Ba_M_ST129SA -1.13376 1.67e-01 3.22e-01 6.19e-01 0.625 0.750 0.754 0.630 0.745 0.746 0.01143 0.237 3.04 2.75 0.30
pander::pander(bConvmlD$univariate[bConvmlD$selectedfeatures,])
  Name RName ZUni
Ba_ADAS13 Ba_ADAS13 Ba_ADAS13 11.37
FAQ FAQ FAQ 8.88
De_Hippocampus De_Hippocampus De_Hippocampus 9.53
RD_ST31TA RD_ST31TA RD_ST31TA 3.78
RD_ST65SV RD_ST65SV RD_ST65SV 2.04
De_M_ST51CV De_M_ST51CV De_M_ST51CV 2.19
De_RAVLT_immediate De_RAVLT_immediate De_RAVLT_immediate 1.47
De_M_ST48CV De_M_ST48CV De_M_ST48CV 3.56
Ba_M_ST56SA Ba_M_ST56SA Ba_M_ST56SA 4.74
De_M_ST12SV De_M_ST12SV De_M_ST12SV 3.60
Gender Gender Gender 1.56
Ba_RAVLT_learning Ba_RAVLT_learning Ba_RAVLT_learning 6.31
De_M_ST40SA De_M_ST40SA De_M_ST40SA 6.75
De_M_ST32TA De_M_ST32TA De_M_ST32TA 3.27
Ba_M_ST129SA Ba_M_ST129SA Ba_M_ST129SA 6.25
M_ST49CV M_ST49CV M_ST49CV 5.60
Ba_RAVLT_forgetting Ba_RAVLT_forgetting Ba_RAVLT_forgetting 2.93
De_RAVLT_perc_forgetting De_RAVLT_perc_forgetting De_RAVLT_perc_forgetting 4.94
Ba_RD_ST49SA Ba_RD_ST49SA Ba_RD_ST49SA 2.15
De_M_ST60SA De_M_ST60SA De_M_ST60SA 5.34
RD_ST59TA RD_ST59TA RD_ST59TA 2.24

ptestl <- predict(bConvmlD,TADPOLE_Conv_TESTD,type="lp")
boxplot(ptestl~TADPOLE_Conv_TEST$status)

ptestr <- predict(bConvmlD,TADPOLE_Conv_TESTD,type="risk")
eventCases <- subset(TADPOLE_Conv_TEST,status==1)
plot(1.0/ptestr[rownames(eventCases)]~eventCases$TimeToEvent)

pander::pander(cor.test(eventCases$TimeToEvent,1.0/ptestr[rownames(eventCases)],method="spearman"))
Spearman’s rank correlation rho: eventCases$TimeToEvent and 1/ptestr[rownames(eventCases)]
Test statistic P value Alternative hypothesis rho
98622 0.000168 * * * two.sided 0.371



perdsurv <- cbind(TADPOLE_Conv_TEST$TimeToEvent,
                  TADPOLE_Conv_TEST$status,
                  ptestl,
                  ptestr)
prSurv <- predictionStats_survival(perdsurv,"MCI to  AD Conversion")

pander::pander(prSurv$CIRisk)
median lower upper
0.82 0.777 0.861
pander::pander(prSurv$CILp)
median lower upper
0.838 0.791 0.884
pander::pander(prSurv$spearmanCI)
50% 2.5% 97.5%
0.371 0.182 0.538

prBin <- predictionStats_binary(cbind(TADPOLE_Conv_TESTD$status,ptestl),"MCI to  AD Conversion")

MCI to AD Conversion

pander::pander(prBin$aucs)
est lower upper
0.837 0.789 0.886
pander::pander(prBin$CM.analysis$tab)
  Outcome + Outcome - Total
Test + 75 43 118
Test - 23 132 155
Total 98 175 273

par(op)

5.2.2 The formula network

cmax <- apply(bConvmlD$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bConvmlD$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=5*E(gr)$weight,
     vertex.size=20*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="MCI to Dementia Conversion")

par(op)

5.2.3 Decorrelated MCI to Dementia table


clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableMCI_to_DemD <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "HR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableMCI_to_DemD$Cluster <- nugget[rownames(tableMCI_to_DemD)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableMCI_to_DemD$Description <- description[rownames(tableMCI_to_DemD)]


## Getting the decorrelation formula
dc <- getDerivedCoefficients(TADPOLE_Conv_TRAIND)
decornames <- rownames(sm$coefficients)

deNames_in_dc <- decornames[decornames %in% names(dc)]
theDeFormulas <- dc[deNames_in_dc]
deFromula <- character(length(theDeFormulas))
names(deFromula) <- names(theDeFormulas)
for (dx in names(deFromula))
{
  coef <- theDeFormulas[[dx]]
  cname <- names(theDeFormulas[[dx]])
  names(cname) <- cname
  for (cf in names(coef))
  {
    if (cf != dx)
    {
      if (coef[cf]>0)
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("+ %5.3f*%s",coef[cf],cname[cf]))
      }
      else
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("%5.3f*%s",coef[cf],cname[cf]))
      }
    }
  }
}

tableMCI_to_DemD$DecorFormula <- deFromula[rownames(tableMCI_to_DemD)]


pander::pander(tableMCI_to_DemD)
  Estimate lower HR upper full.AUC DeltaAUC z.IDI Frequency Cluster Description DecorFormula
Ba_ADAS13 0.08875 1.07e+00 1.09e+00 1.11e+00 0.782 0.01103 7.96 1.00 1 NA NA
FAQ 0.07336 1.06e+00 1.08e+00 1.09e+00 0.782 0.02759 7.23 1.00 1 NA NA
De_Hippocampus -23.08759 1.15e-14 9.40e-11 7.71e-07 0.782 0.01098 4.92 1.00 1 NA NA
RD_ST31TA 3.44686 7.26e+00 3.14e+01 1.36e+02 0.781 0.00238 4.52 0.75 1 Cortical Thickness Average of LeftInferiorParietal NA
RD_ST65SV -3.93478 3.14e-03 1.95e-02 1.22e-01 0.783 0.01113 4.09 0.25 1 Volume (WM Parcellation) of LeftVentralDC NA
De_RAVLT_immediate -0.01446 9.78e-01 9.86e-01 9.93e-01 0.780 -0.00607 3.77 0.40 1 NA + 1.036ADAS13 + 1.000RAVLT_immediate
De_M_ST48CV -34.43520 1.16e-22 1.11e-15 1.06e-08 0.779 0.00527 4.07 0.75 1 Volume (Cortical Parcellation) of LeftPericalcarine -5.634M_ST48TS -0.233M_ST48SA + 1.000*M_ST48CV
Ba_RAVLT_learning -0.05361 9.32e-01 9.48e-01 9.64e-01 0.745 0.03191 5.88 0.55 2 NA NA
De_M_ST40SA -4.45130 2.40e-03 1.17e-02 5.66e-02 0.745 0.03297 5.46 0.55 2 Surface Area of LeftMiddleTemporal NA
De_M_ST32TA -77.26965 1.84e-46 2.77e-34 4.16e-22 0.745 0.01654 5.32 0.55 2 Cortical Thickness Average of LeftInferiorTemporal + 1.000M_ST32TA -0.810M_ST59TA
Ba_M_ST129SA -1.13376 1.67e-01 3.22e-01 6.19e-01 0.746 0.00160 3.04 0.30 2 Surface Area of LeftInsula NA
De_RAVLT_perc_forgetting 0.00748 1.00e+00 1.01e+00 1.01e+00 0.745 0.01388 4.52 0.55 2 NA + 5.300RAVLT_learning -11.044RAVLT_forgetting + 1.000*RAVLT_perc_forgetting
Ba_RD_ST49SA -2.47656 3.00e-02 8.40e-02 2.35e-01 0.745 0.01482 4.62 0.55 2 Surface Area of LeftPostcentral NA

5.2.4 Saving the enviroment

save.image("~/GitHub/BSWiMS/TADPOLE_BSWIMS_Results.RData")